[求助]这个程序出了问题，请求高手指点迷津！谢谢！
<p><font face="Verdana">;;消除重复线条 <br/>(defun c:XCF(/ dxf tang chg_ent on_ent undup os 2pi sline sarc scircle n ss ent pmt)<br/> (defun dxf(ent i)<br/> (cdr (assoc i (entget ent)))<br/> )<br/> (defun tang(ang sty)<br/> (rem (+ 2pi ang) sty)<br/> )<br/> (defun chg_ent(ent i pt / en)<br/> (setq en (entget ent) en (subst (cons i pt) (assoc i en) en))<br/> (entmod en)<br/> )<br/> (defun on_ent(a a1 a2 sty)<br/> (if (= sty "直线")<br/> (equal (+ (distance a1 a) (distance a a2)) (distance a1 a2) 0.01)<br/> (if (> a2 a1) (>= a2 a a1) (or (<= a a2) (>= a a1)))<br/> )<br/> )<br/> (defun undup(s sty / nm m ss ent1 spt1 ept1 cpt1 r1 ent2 spt2 ept2 cpt2 r2)<br/> (setq n -1 nm 0)<br/> (if (= sty "圆")<br/> (repeat (sslength s)<br/> (setq ent1 (ssname s (setq n (1+ n))))<br/> (if (entget ent1)<br/> (progn<br/> (setq cpt1 (dxf ent1 10) r1 (dxf ent1 40))<br/> (if (setq ss (ssget "x" (list (cons 0 "circle") (cons 10 cpt1) (cons 40 r1))))<br/> (progn<br/> (ssdel ent1 ss)<br/> (setq m -1)<br/> (repeat (sslength ss)<br/> (setq ent (ssname ss (setq m (1+ m))))<br/> (if (not (ssmemb ent s))<br/> (progn<br/> (ssdel ent ss)<br/> (setq m (1- m))<br/> )<br/> )<br/> )<br/> (command "_.erase" ss "")<br/> (setq nm (+ nm (sslength ss)))<br/> )<br/> )<br/> )<br/> )<br/> )<br/> (repeat (sslength s)<br/> (setq ent1 (ssname s (setq n (1+ n))))<br/> (if (entget ent1)<br/> (progn<br/> (if (= sty "直线")<br/> (setq spt1 (dxf ent1 10) ept1 (dxf ent1 11))<br/> (setq spt1 (tang (dxf ent1 50) 2pi)<br/> ept1 (tang (dxf ent1 51) 2pi)<br/> cpt1 (dxf ent1 10)<br/> r1 (dxf ent1 40)<br/> )<br/> )<br/> (if (setq ss (if (= sty "直线")<br/> (ssget "cp" (list (polar spt1 (angle ept1 spt1) 0.1)<br/> (polar ept1 (- (angle spt1 ept1) (/ pi 4)) 0.15)<br/> (polar ept1 (+ (angle spt1 ept1) (/ pi 4)) 0.15)<br/> ) '((0 . "line"))<br/> )<br/> (ssget "x" (list (cons 0 "arc") (cons 10 cpt1) (cons 40 r1)))<br/> )<br/> )<br/> (progn<br/> (ssdel ent1 ss)<br/> (setq m -1)<br/> (repeat (sslength ss)<br/> (setq ent (ssname ss (setq m (1+ m))))<br/> (if (not (ssmemb ent s))<br/> (progn<br/> (ssdel ent ss)<br/> (setq m (1- m))<br/> )<br/> )<br/> )<br/> (setq m -1)<br/> (repeat (sslength ss)<br/> (setq ent2 (ssname ss (setq m (1+ m))))<br/> (if (= sty "直线")<br/> (setq spt2 (dxf ent2 10)<br/> ept2 (dxf ent2 11)<br/> )<br/> setq spt2 (tang (dxf ent2 50) 2pi)<br/> ept2 (tang (dxf ent2 51) 2pi)<br/> cpt2 (dxf ent2 10)<br/> r2 (dxf ent2 40)<br/> )<br/> )<br/> (cond<br/> ((and (on_ent spt2 spt1 ept1 sty) (on_ent ept2 spt1 ept1 sty))<br/> (entdel ent2)<br/> )<br/> ((and (on_ent spt1 spt2 ept2 sty) (on_ent ept1 spt2 ept2 sty))<br/> (entdel ent1)<br/> (setq ent1 ent2 spt1 spt2 ept1 ept2)<br/> (if (= sty "圆弧")<br/> (setq cpt1 cpt2 r1 r2)<br/> )<br/> )<br/> ((and (if (= sty "直线")<br/> (equal (tang (angle spt1 ept1) pi) (tang (angle spt2 ept2) pi) 0.001)<br/> T<br/> )<br/> (or (on_ent spt2 spt1 ept1 sty) (on_ent ept2 spt1 ept1 sty))<br/> )<br/> (entdel ent2)<br/> (if (= sty "直线")<br/> (progn<br/> (if (on_ent spt2 spt1 ept1 sty)<br/> (setq spt2 ept2)<br/> )<br/> (if (> (distance spt1 spt2) (distance ept1 spt2))<br/> (progn (chg_ent ent1 11 spt2) (setq ept1 spt2))<br/> (progn (chg_ent ent1 10 spt2) (setq spt1 spt2))<br/> )<br/> )<br/> (if (on_ent spt2 spt1 ept1 sty)<br/> (progn (chg_ent ent1 51 ept2) (setq ept1 ept2))<br/> (progn (chg_ent ent1 50 spt2) (setq spt1 spt2))<br/> )<br/> )<br/> )<br/> (T (setq nm (1- nm)))<br/> )<br/> (setq nm (1+ nm))<br/> )<br/> )<br/> )<br/> )<br/> )<br/> )<br/> )<br/> (prompt (strcat "选到" (itoa (sslength s)) "个" sty "消去" (itoa nm) "个！"))<br/> )<br/> (command "_.undo" "_be")<br/> (command "_.ucs" "")<br/> (setq os (getvar "osmode")<br/> 2pi (* 2 pi)<br/> sline (ssadd)<br/> sarc (ssadd)<br/> scircle (ssadd)<br/> n -1<br/> )<br/> (setvar "cmdecho" 0)<br/> (setvar "osmode" 0)<br/> (PRINC "\n消除重复线功能")(PRINC) <br/> (prompt "\n→请选择直线、圆弧或圆：")<br/> (if (setq ss (ssget '((0 . "line,arc,circle"))))<br/> (progn<br/> (prompt "\n→正在消除重复线条，请稍候...")<br/> (prompt "\n")<br/> (repeat (sslength ss)<br/> (setq ent (ssname ss (setq n (1+ n))))<br/> (cond<br/> ((= (dxf ent 0) "LINE") (ssadd ent sline))<br/> ((= (dxf ent 0) "CIRCLE") (ssadd ent scircle))<br/> )<br/> )<br/> )<br/> )<br/> (if (> (sslength sline) 1) (progn (undup sline "直线") (setq pmt T)))<br/> (if (> (sslength sarc) 1) (progn (undup sarc "圆弧") (setq pmt T)))<br/> (if (> (sslength scircle) 1) (progn (undup scircle "圆") (setq pmt T)))<br/> (if (and ss (not pmt)) (prompt "\n→没有重复实体！"))<br/> (setvar "osmode" os)<br/> (command "_.undo" "_e")<br/> (princ)<br/> (PRINC "\n所选地方→消除重复线完成！")(PRINC))</font></p><p><font face="Verdana"><br/></font> </p>
页:
[1]