Tools/代码/LSP/咪咪 dgx1.lsp

(defun c:zh();转换新线形

(prompt "请选择线: ")
(setq object (entsel))
    (SETQ SSS (ssget "x" '((-4 . "<OR") 
           (0 . "LWPOLYLINE") 
	   (0 . "POLYLINE")
             (-4 . "OR>"))
     ))
   (setq i 0)
   (if sss
      (while (< i (sslength sss))
        (setq OBJ (ssname sss i))
       (huan2)
            (setq i (+ i 1))
   ) ;WHILE
  ) ;IF SSS

 (setq b  (itoa  i) )
 (setq b1 (strcat "图中共检查修改旧line线划有:"  b   "条"  ) )

)


(defun huan2()
(setvar "CMDECHO" 0)
   (command"osnap" "off")
(setq obj_38 nil)
   (setq  obj_b(entget obj  '("SHANXI" "SOUTH")))
   (setq obj_la (cdr(assoc 8 obj_b)))
   (setq obj_lt (cdr(assoc 6 obj_b)))
   (setq obj_color (cdr(assoc 62 obj_b)))
   (setq obj_70 (cdr(assoc 70 obj_b)))
   (setq obj_40 (cdr(assoc 40 obj_b)))
   (setq obj_38 (cdr(assoc 38 obj_b)))
   (if(= obj_38 nil)
     (setq obj_38 (nth 2 (cdr(assoc 10 obj_b))))
    )
   (setq obj_xdata (assoc -3 obj_b) )
   (command "layer" "S" obj_la "") 
   (setq  obj_b (qd_b1 obj) ) 
   (setq nnn(length obj_b))
   (setq j (- nnn 1))
   (if(or(= obj_70 5)(= obj_70 133)) (setq nnn (- nnn 1)))
   (setq p0(nth j obj_b))
   (command "pline")
   (repeat nnn
     (setq p1(nth j obj_b))
     (command p1)
     (setq j (- j 1))
   )
      (if( /= (/ obj_70 2) (/ obj_70 2.0) ) 
    (command p0))
  (command)
  (command"erase" obj "")
 
  (if (/= obj_lt nil)(command"change" (entlast) "" "p" "lt" obj_lt "")  )
  (if (/= obj_color nil) (command"change" (entlast) "" "p" "c" obj_color "")  )
  (if (/= obj_40 nil) (command"pedit" (entlast) "w" obj_40 "")  )
  (if (/= obj_38 nil) (command"change" (entlast) "" "p" "e" obj_38 "")  )

  (setq object  (entget (entlast)))

   (if (/= obj_xdata nil)(progn
   (setq xdata (list obj_xdata))
   (setq nent (append object  xdata))
   (entmod nent) 
 ))
 (setq object (entlast) ) 
)

(defun huan3()
(setvar "CMDECHO" 0)
   (command"osnap" "off")
(setq obj_38 nil)
   (setq  obj_b(entget obj  '("SHANXI" "SOUTH")))
   (setq obj_la (cdr(assoc 8 obj_b)))
   (setq obj_lt (cdr(assoc 6 obj_b)))
   (setq obj_color (cdr(assoc 62 obj_b)))
   (setq obj_70 (cdr(assoc 70 obj_b)))
   (setq obj_40 (cdr(assoc 40 obj_b)))
   (setq obj_38 (cdr(assoc 38 obj_b)))
   (if(= obj_38 nil)
     (setq obj_38 (nth 2 (cdr(assoc 10 obj_b))))
    )
 
  (setq obj_xdata (assoc -3 obj_b) )
   (command "layer" "S" obj_la "") 

   (setq  obj_b (qd_b1 obj) ) 
   (setq nnn(length obj_b))
   (setq j 0)
   (if(or(= obj_70 5)(= obj_70 133)) (setq nnn (- nnn 1)))
   (setq p0(nth j obj_b))
   (command "pline")
   (repeat nnn
     (setq p1(nth j obj_b))
     (command p1)
     (setq j (+ j 1))
   )
   
   (if( /= (/ obj_70 2) (/ obj_70 2.0) ) 
    (command p0))
  (command)
  (command"erase" obj "")
 
  (if (/= obj_lt nil)(command"change" (entlast) "" "p" "lt" obj_lt "")  )
  (if (/= obj_color nil) (command"change" (entlast) "" "p" "c" obj_color "")  )
  (if (/= obj_40 nil) (command"pedit" (entlast) "w" obj_40 "")  )
  (if (/= obj_38 nil) (command"change" (entlast) "" "p" "e" obj_38 "")  )

  (setq object  (entget (entlast)))

   (if (/= obj_xdata nil)(progn
   (setq xdata (list obj_xdata))
   (setq nent (append object  xdata))
   (entmod nent) 
 ))
 (setq object (entlast) ) 
)


(defun qd_b1(obj_1971);    获取新旧线坐标
  (setq dxfb_1971(entget obj_1971))
  (setq obty_1971 (cdr (assoc 0 dxfb_1971)) )
  (SETQ DB_PL '())
  (Cond
    ((= obty_1971 "POLYLINE")  
      (setq obj_1971 (entnext obj_1971))
      (setq dxfb_1971 (entget obj_1971)) 
      (setq po_1971 (cdr (assoc  10  dxfb_1971)))
      (SETQ DB_PL '())
      (while (/= (cdr (assoc 0 dxfb_1971)) "SEQEND")
        (setq po_1971(list (nth 0 po_1971) (nth 1 po_1971) (nth 2 po_1971)))
            (SETQ DB_PL(APPEND DB_PL (list po_1971)))
        (setq obj_1971 (entnext obj_1971))
        (setq dxfb_1971 (entget obj_1971)) 
        (while(= (cdr (assoc 70 dxfb_1971)) 16) 
          (setq obj_1971 (entnext obj_1971))
          (setq dxfb_1971 (entget obj_1971)) 
          )
        (setq po_1971 (cdr (assoc  10  dxfb_1971)))
           )
        )
    ((= obty_1971 "LWPOLYLINE")
       (SETQ NNN(length dxfb_1971))
         (SETQ K 0)
         (SETQ DB_PL '())
         (REPEAT NNN
           (SETQ po_1971 (NTH K dxfb_1971))
           (if(= (car po_1971) 10)
             (setq DB_PL(append DB_PL (list (cdr po_1971))))
             )
           (SETQ K (+ K 1))
           )
        )
      

    ((= obty_1971 "LINE")
       (SETQ NNN(length dxfb_1971))
         (SETQ K 0)
         (SETQ DB_PL '())
         (REPEAT NNN
           (SETQ po_1971 (NTH K dxfb_1971))
           (if( or (= (car po_1971) 10)(= (car po_1971) 11))
             (setq DB_PL(append DB_PL (list (cdr po_1971))))
             )
           (SETQ K (+ K 1))
           )
        )
      )



  DB_PL
)




(defun c:1();等高线连接修改
   (command "osnap" "off")
   (prompt "选择实体的断点处")
   (setq obj1(entsel))
   (setq ob_pp (car (cdr obj1)))
   (setq ddx (cdr( assoc 0 (entget (car obj1)'("*"))) ))
   (setq obja (car obj1))
   (setq sxxx ( assoc -3(entget obja'("*"))) )
 (if (= ddx "POLYLINE" )
   (progn
   (command "tolwpoly" obj1 "")
   (setq obja nil)
   (setq obja (entlast))) )
   
   (SETQ OBJC OBJA)   (setq  obj_b(entget obja))
   (setq obj_la (cdr(assoc 8 obj_b)))    (setq obj_lt (cdr(assoc 6 obj_b)))
   (setq wid (cdr(assoc 40 obj_b)))    (setq w38 (cdr(assoc 38 obj_b)))
   (setq c70 (cdr(assoc 70 obj_b))) 
   (if (= c70 129) (setq c70 1))
   (command"linetype" "s" obj_lt "")    (command"layer" "s" obj_la "")
   (setq p1 (list (nth 0 ob_pp) (nth 1 ob_pp)))
  ; (command "pedit" obja "d" "x")
   (setq ssb (ssget "x" (LIST (cons 0 "polyline,lwpolyline")(cons 38 w38)(cons 8 obj_la))))
   (setq i 0) (if ssb (while (< i (sslength ssb))  (redraw (ssname ssb i) 3) (setq i (+ i 1)) ))
   (plin2a)
   (setq i 0) (if ssb (while (< i (sslength ssb))  (redraw (ssname ssb i) 4) (setq i (+ i 1)) ))
   (setq ssb nil)
   (setq vwi (getvar "VIEWSIZE"))
   (setq pzjl (/  vwi 50))

   (setq zbd nil)  (setq zbd (qd_b1 object) )
   (setq pb1 (nth 0 zbd))
   (setq pb2 (nth (- (length zbd) 1) zbd))

 ''''''''''''
   (setq zbb nil)  (setq zbb (qd_b1 obja) )
   (if (= c70 1)  (setq zbb (append zbb (list (nth 0 zbb)))) )
   (if (equal (nth 0 zbb) (nth (- (length zbb) 1) zbb) 1)  (setq c70 1))
   (setq p1 pb1) (setq i 1)  (jdjs) (setq ds i)
   (setq jda (/ (* (angle (nth (- i 1) zbb) (nth i zbb)) 180) pi))
   (setq jdb (/ (* (angle (nth 0 zbd) (nth 1 zbd)) 180) pi))
   (setq jdc (- jda jdb))
   (if (< jdc 0) (setq jdc (- 0 jdc)))
   (if (> jdc 180) (setq jdc (- 360 jdc)))
   (setq xxfz 0)
   (if (> jdc 90) (progn (setq zbb (reverse zbb)) (setq ds (- (length zbb) ds)) (setq xxfz 1) ))  
   (if (= c70 1) (progn
    (setq zbs '()) (setq i (- ds 1))
    (repeat (- (length zbb) ds) (setq zbs (append zbs (list (nth i zbb)))) (setq i (+ i 1)))
    (setq i 0)
    (repeat ds (setq zbs (append zbs (list (nth i zbb)))) (setq i (+ i 1)))
    (setq zbb zbs) (setq zbs nil) (setq ds 1)
   ))

   (setq zb '())
   (setq i 0) (repeat (- ds 1)  (setq zb (append zb (list (nth i zbb))))   (setq i (+ 1 i))  )
   (entdel object) (setq i 0) (command "pline") (command (nth (- ds 1) zbb))
   (repeat (length zbd)   (command (nth i zbd))  (setq i (+ i 1)) )  (command "")
   (setq object (entlast))   (setq zbd nil)  (setq zbd (qd_b1 object) ) 
   (setq jdzb nil)
   (setq q1 (polar pb2 3.97 pzjl))  (setq q2 (polar pb2 0.83 pzjl)) 
   (setq ssa (ssget "c" q1 q2 (LIST (cons 0 "polyline,lwpolyline")(cons 38 w38)(cons 8 obj_la))))
   (if ssa (if (ssmemb object ssa)  (setq ssa (ssdel object ssa)) ) )
   (if ssa (if (= (sslength ssa) 0) (setq ssa nil)))
   (if ssa
   (if (ssmemb obja ssa)
    (progn '''同一实体
      (setq p1 pb2) (setq i ds)  (jdjs)  (setq ds1 i)
      (entdel object) (setq i 0) (command "pline")    
      (repeat (- (length zbd) 1)   (command (nth i zbd))  (setq i (+ i 1)) )   
      (command jdzb)  (command (nth ds1 zbb))(command "")
      (setq object (entlast))   (setq zbd nil)  (setq zbd (qd_b1 object) ) 
   )
   (progn  '''不同实体
      (setq OBJb (ssname ssa 0))     
      (setq zbb nil)
      (setq zbb (qd_b1 objb) ) 
      (setq p1 pb2) (setq i 1)  (jdjs)  (setq ds1 i)
      (setq jda (/ (* (angle (nth (- i 1) zbb) (nth i zbb)) 180) pi))
      (setq zbdl (- (length zbd) 1))
      (setq jdb (/ (* (angle (nth (- zbdl 1) zbd) (nth zbdl zbd)) 180) pi))
      (setq jdc (- jda jdb))
      (if (< jdc 0) (setq jdc (- 0 jdc)))
      (if (> jdc 180) (setq jdc (- 360 jdc)))
      (if (> jdc 90) (progn (setq zbb (reverse zbb)) (setq ds1  (- (length zbb) ds1)  ) ))  
      (entdel object) (setq i 0) (command "pline")    
      (repeat (- (length zbd) 1)   (command (nth i zbd))  (setq i (+ i 1)) )   
      (command jdzb)  (command (nth ds1 zbb))(command "")
      (setq object (entlast))   (setq zbd nil)  (setq zbd (qd_b1 object) ) 
      (entdel objb)
   )
  )  
 )

    (command"pedit" object "s" "")  (setq obj object)(huan3)
    (setq obj object) (cd1)  (setq object (entlast))
    (setq zba nil)   (setq zba (qd_b1 object) ) 
    (setq i 1) (repeat (- (length zba) 1)  (setq zb (append zb (list (nth i zba))))   (setq i (+ 1 i))  )
 
     (if jdzb (progn
       (setq  i (+ ds1 1))
       (repeat (- (- (length zbb) ds1) 1)  (setq zb (append zb (list (nth i zbb))))   (setq i (+ 1 i)) )  
     ))
    (if (= xxfz 1) (setq zb (reverse zb)) )     
    (setq i 0) (command "pline")
    (repeat (length zb)   (command (nth i zb))  (setq i (+ i 1))    )
    (if (= c70 1)   (command "c")(command ""))
    (if (/= wid nil) (command"pedit" (entlast) "w" wid "")  )
    (if (/= w38 nil) (command"change" (entlast) "" "p" "e" w38 "")  )
    (COMMAND "_matchprop" OBJ1 (entlast) "")
  (if (/= sxxx nil)
    (setq dww (entmod (append (entget (entlast)) (list sxxx))) ) )
     (command"linetype" "s" Continuous "")    (command"layer" "s" 0 "")
    (command "redraw")
    (ENTDEL OBJECT)   (ENTDEL OBJC )  
)


(defun cd1()
   (setq obj_40 nil)
   (setq obj_lt nil)
   (setq obj_color nil)
   (setq  obj_b(entget obj  ))
   (setq obj_la (cdr(assoc 8 obj_b)))
   (setq obj_lt (cdr(assoc 6 obj_b)))
   (setq obj_color (cdr(assoc 62 obj_b)))
   (setq obj_70 (cdr(assoc 70 obj_b)))
   (setq obj_40 (cdr(assoc 40 obj_b)))
   (setq obj_xdata (assoc -3 obj_b) )
  
   (setq  DB_zb (qd_b1 obj) ) 
  
  
    (setq nnn(length db_zb))
    (if(or(= obj_70 5)(= obj_70 133)) (setq nnn (- nnn 1)))
    
   (setq p0(nth 0 db_zb))
   (setq p2 p0)
   (command "osnap" "off")
   (command "pline" p0 "w" 0 0)
   (setq j 1)
   (setq jdd 0)
   (repeat (- nnn 2)
     (setq p1(nth j db_zb))
     (setq p3(nth (+ j 1) db_zb))
      (setq jda (angle p2 p1))
      (setq jdb (angle p2 p3))
      (setq jdc (abs (- jda jdb)))
      (if (> jdc pi) (setq jdc (- (* 2 pi) jdc)))

      (if (or (> (distance p1 p2) 4) (> (+ jdd jdc) 0.05)) 
       (progn
         (command p1)
         (setq jdd 0)         
         (setq p2 p1)
      )
        (setq jdd (+ jdd jdc)) 
      )
     (setq j (+ j 1))
   )
 
   (setq p1 (nth (- nnn 1) db_zb))
   (command p1)  


   
    (if( /= (/ obj_70 2) (/ obj_70 2.0) ) (command p0))
   (command)



  (command"erase" obj "")

  
  (setq object  (entget (entlast)))

  (if obj_la  
    (setq object (subst (cons 8 obj_la) (assoc 8 object) object))
  )
  (if obj_lt  
    (setq object (subst (cons 6 obj_lt) (assoc 6 object) object))
  )
  (if obj_color  
    (setq object (subst (cons 62 obj_color) (assoc 62 object) object))
  )
 

     (entmod object)
   (if (/= obj_xdata nil)(progn
     (setq xdata (list obj_xdata))
     (setq nent (append object  xdata))
     (entmod nent) 
   ))
(if obj_40 (progn
    (command "pedit" (entlast) "w" obj_40 "x")
  
  ))

) 




(defun plin2a()
   (command"pline" "near" p1 "w" wid wid)  
    (setq i 1) 
     (while (/= p1 nil)
       (initget 128)                       
       (setq p1 (getpoint p1 "\n/Undo退回/Point选择新点: "))    
       (if (= 'STR (type p1))    
         (progn
           (setq p1 (strcase p1))  
           (if (= p1 "U")
             (progn
               (if (> i 1) (setq i (- i 1)))               
               (command p1)(setq p1 p2)
             );progn
           ) 
        
         ) ;progn
         (progn
           (if (/= p1 nil)
             (setq p2 p1) 
           )                              
           (command p1) (print p1)
           (setq i (+  i 1)) 
        ) ;progn
         ) ;if
     );while
    (setq object (entlast))
      
)

(defun jdjs()
  (setq jdzb nil)
  (setq q1 (nth (- i 1) zbb))
  (while (and (= jdzb nil) (< i (length zbb)))
   (setq q2 q1)    
   (setq q1 (nth i zbb))
   (setq jd (angle q2 q1))
   (setq p2 (polar p1 (+ jd (/ pi 2)) pzjl))    (setq p3 (polar p1 (- jd (/ pi 2)) pzjl))
   (setq jdzb (inters q1 q2 p2 p3))
   (setq i (+ i 1))
  )
  (setq i (- i 1))     
)