(defun c:zh();转换新线形 (prompt "请选择线: ") (setq object (entsel)) (SETQ SSS (ssget "x" '((-4 . "")) )) (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)) )