尘缘一生 发表于 2022-11-22 08:23:56

清理重复实体类集成（三领）

本帖最后由 尘缘一生 于 2022-11-22 22:09 编辑


[*];;图元合并删除、合并----【开始】------
[*](defun c:duprem (/ ss)
[*](setq ss (ssget '((0 . "LINE,*POLYLINE,TEXT,MTEXT,CIRCLE,ARC,INSERT"))))
[*](ssduppe ss)
[*])
[*]

[*];;(删除选择集中重叠的线、多段线、圆、圆弧、块、文字)----(一级)----
[*](defun ssduppe (ss / e name lis lw ly cl tp p1 p2 e_lst n slinearc spline scircle sinsert stxt)
[*](setq e_lst (sysvar '("OSMODE" "CMDECHO")))
[*](setvar "OSMODE" 0)
[*](setvar "CMDECHO" 0)
[*](_undo1)
[*](command "_.ucs" "")
[*](setq slinearc (ssadd) spline (ssadd) scircle (ssadd) sinsert (ssadd) stxt (ssadd))
[*](repeat (setq n (sslength ss))
[*]    (setq name (ssname ss (setq n (1- n))) tp (dxf1 name 0) ly (dxf1 name 8) cl (ss-getcolor name) lw (linwind name))
[*]    (cond
[*]      ((or (= tp "LINE") (= tp "ARC"))
[*]      (ssadd name slinearc)
[*]      )
[*]      ((and (= tp "LWPOLYLINE") (= lw 0) (= (dxf1 name 90) 2)) ;;0宽度两点多段线
[*]      (setq p1 (vlax-curve-getstartpoint (en2obj name))
[*]          p2 (vlax-curve-getendpoint (en2obj name))
[*]      )
[*]      (entdel name) (ssdel name ss)
[*]      (fy_lineformat (makeline p1 p2) nil nil nil nil)
[*]      (ssadd (entlast) slinearc) ;转直线集处理
[*]      )
[*]      ((and (= tp "LWPOLYLINE") (= lw 0) (> (dxf1 name 90) 2) ;;0宽度3点以上多段线
[*]         (= (sl:pts-onLine (setq lis (order-pt (get-pl-pt name)))) t) ;共线
[*]       )
[*]      (entdel name) (ssdel name ss)
[*]      (fy_lineformat (makeline (car lis) (last lis)) nil nil nil nil)
[*]      (ssadd (entlast) slinearc);转直线集处理
[*]      )
[*]      ((and (= tp "LWPOLYLINE") (= lw 0) (> (dxf1 name 90) 2) ;;0宽度3点以上多段线
[*]         (= (sl:pts-onLine (get-pl-pt name)) nil) ;不共线
[*]       )
[*]      (ssadd name spline) ;转多段线集处理
[*]      )
[*]      ((and (= tp "LWPOLYLINE") (> lw 0)) ;有宽度二维多段线
[*]      (ssadd name spline) ;转多段线集处理
[*]      )
[*]      ((and (= tp "POLYLINE") (> lw 0));有宽度三维多段线
[*]      (setq lis (get-pl-pt name))
[*]      (if (= (dxf1 name 70) 8) ;不闭合
[*]          (slch:lwpolyline lis nil lw ly cl nil)
[*]          (slch:lwpolyline lis t lw ly cl nil)
[*]      )
[*]      (entdel name)
[*]      (ssadd (entlast) spline) ;转多段线集处理
[*]      )
[*]      ((and (= tp "POLYLINE") (= lw 0));0宽度三维多段线
[*]      (setq lis (get-pl-pt name))
[*]      (entdel name) (ssdel name ss)
[*]      (repeat (setq i (1- (length lis)))
[*]          (fy_lineformat (makeline (nth i lis) (nth (1- i) lis)) nil nil nil nil)
[*]          (ssadd (entlast) slinearc) ;转直线集处理
[*]      )
[*]      )
[*]      ((= tp "CIRCLE")
[*]      (ssadd name scircle)
[*]      )
[*]      ((= tp "INSERT")
[*]      (ssadd name sinsert)
[*]      )
[*]      ((or (= tp "TEXT") (= tp "MTEXT"))
[*]      (ssadd name stxt)
[*]      )
[*]    )
[*])
[*](if (> (sslength slinearc) 1) (vl-catch-all-apply 'undup (list slinearc))) ;直线 弧
[*](if (> (sslength spline) 1) (vl-catch-all-apply 'unduppl (list spline))) ;多段线
[*](if (> (sslength scircle) 1) (undup-cir scircle)) ;圆
[*](if (> (sslength stxt) 1) (deladtxt stxt)) ;文字
[*](if (> (sslength sinsert) 1) (congfukuai sinsert));块
[*](mapcar 'eval e_lst)
[*](_undo2)
[*])
[*];;删除重复的线LINE 弧 CIR----(一级)-------
[*];;s:选择集
[*](defun undup (s / ang k a a1 a2 sty sline sarc n enam tp e_lst)
[*](defun t-ang (ang k)
[*]    (rem (+ 2pi ang) k)
[*])
[*];;判断a是否在 a1至a2两点连线上----
[*](defun on_ent (a a1 a2 sty)
[*]    (if (= sty "line")
[*]      (equal (+ (distance a1 a) (distance a a2)) (distance a1 a2) 0.01)
[*]      (if (> a2 a1) (>= a2 a a1) (or (<= a a2) (>= a a1)))
[*]    )
[*])
[*];;s:选择集 sty:实体类型字符串"line""arc"
[*](defun slundup (s sty / nm m n ss nam enam1 enam2 spt1 ept1 cpt1 r1 r2 spt2 ept2 cpt2 ptlis d1 d2 d3 d4)
[*]    (setq nm 0)
[*]    (if (= sty "line") ;;删除长度小于 0.01的直线
[*]      (repeat (setq n (sslength s))
[*]      (setq enam1 (ssname s (setq n (1- n))))
[*]      (setq spt1 (dxf1 enam1 10) ept1 (dxf1 enam1 11))
[*]      (if (<= (distance spt1 ept1) 0.01)
[*]          (progn (ssdel enam1 s) (entdel enam1) (setq nm (1+ nm)))
[*]      )
[*]      )
[*]    )
[*]    (repeat (setq n (sslength s)) ;合并重复线、弧
[*]      (setq enam1 (ssname s (setq n (1- n))))
[*]      (if (= sty "line")
[*]      (setq spt1 (dxf1 enam1 10) ept1 (dxf1 enam1 11))
[*]      (setq spt1 (t-ang (dxf1 enam1 50) 2pi)
[*]          ept1 (t-ang (dxf1 enam1 51) 2pi)
[*]          cpt1 (dxf1 enam1 10)
[*]          r1 (dxf1 enam1 40)
[*]      )
[*]      )
[*]      (if
[*]      (setq ss
[*]          (if (= sty "line")
[*]            (ssget
[*]            "CP"
[*]            (list
[*]                (polar spt1 (angle ept1 spt1) (* SLBL 0.2))
[*]                (polar ept1 (- (angle spt1 ept1) pi4) (* SLBL 0.25))
[*]                (polar ept1 (+ (angle spt1 ept1) pi4) (* SLBL 0.25))
[*]            )
[*]            '((0 . "LINE"))
[*]            )
[*]            (ssget "X" (list (cons 0 "ARC") (cons 10 cpt1) (cons 40 r1)))
[*]          )
[*]      )
[*]      (progn
[*]          (ssdel enam1 ss) ;;次选择集先删除主线
[*]          (repeat (setq m (sslength ss))
[*]            (setq nam (ssname ss (setq m (1- m))))
[*]            (if (not (ssmemb nam s)) (ssdel nam ss)) ;;如果主选择集都没有，选择集不交差，删除次选择集实体
[*]          ) ;以上确保 主集S 次集 SS 正确
[*]          (repeat (setq m (sslength ss))
[*]            (setq enam2 (ssname ss (setq m (1- m))))
[*]            (if (= sty "line")
[*]            (setq spt2 (dxf1 enam2 10) ept2 (dxf1 enam2 11))
[*]            (setq spt2 (t-ang (dxf1 enam2 50) 2pi)
[*]                ept2 (t-ang (dxf1 enam2 51) 2pi)
[*]                cpt2 (dxf1 enam2 10)
[*]                r2 (dxf1 enam2 40)
[*]            )
[*]            )
[*]            (cond
[*]            ((and (on_ent spt2 spt1 ept1 sty) (on_ent ept2 spt1 ept1 sty));;次线落在主线上
[*]                (entdel enam2)   ;;删除次线
[*]            )
[*]            ((and (on_ent spt1 spt2 ept2 sty) (on_ent ept1 spt2 ept2 sty)) ;;主线落在次线上
[*]                (entdel enam1)   ;;删除主线
[*]                (setq enam1 enam2 spt1 spt2 ept1 ept2);;次线转为主线
[*]                (if (= sty "arc")
[*]                  (setq cpt1 cpt2 r1 r2)
[*]                )
[*]            )
[*]            ((and
[*]               (if (= sty "line") (equal (angle spt1 ept1) (angle spt2 ept2) 0.001)) ;;平行
[*]               (or (on_ent spt2 spt1 ept1 sty) (on_ent ept2 spt1 ept1 sty)) ;;且一点在线上
[*]               )
[*]                (entdel enam2) ;删除次线
[*]                (if (= sty "line")
[*]                  (progn
[*]                  (if (on_ent spt2 spt1 ept1 sty)
[*]                      (setq spt2 ept2)
[*]                  )
[*]                  (if (> (distance spt1 spt2) (distance ept1 spt2))
[*]                      (progn (sl_subupd enam1 11 spt2) (setq ept1 spt2))
[*]                      (progn (sl_subupd enam1 10 spt2) (setq spt1 spt2))
[*]                  )
[*]                  )
[*]                  (if (on_ent spt2 spt1 ept1 sty)
[*]                  (progn (sl_subupd enam1 51 ept2) (setq ept1 ept2))
[*]                  (progn (sl_subupd enam1 50 spt2) (setq spt1 spt2))
[*]                  )
[*]                )
[*]            )
[*]            ((and
[*]               (= sty "line")
[*]               (= (sl:pts-onLine (list spt1 ept1 spt2 ept2)) t) ;共线判断
[*]               )
[*]                (setq d1 (distance spt1 spt2))
[*]                (setq d2 (distance spt1 ept2))
[*]                (setq d3 (distance ept1 spt2))
[*]                (setq d4 (distance ept1 ept2))
[*]                (if (and (< (min d1 d2 d3 d4) (* SLBL 0.1)))
[*]                  (progn
[*]                  (setq ptlis (order-pt (list spt1 ept1 spt2 ept2)))
[*]                  (entdel enam2) ;;删除次线
[*]                  (sl_subupd enam1 10 (car ptlis))
[*]                  (setq spt1 (car ptlis)) ;下次扩展延伸选择用
[*]                  (sl_subupd enam1 11 (last ptlis))
[*]                  (setq ept1 (last ptlis)) ;下次扩展延伸选择用
[*]                  )
[*]                )
[*]            )
[*]            (T (setq nm (1- nm)))
[*]            )
[*]            (setq nm (1+ nm))
[*]          );end repeat
[*]      )
[*]      )
[*]    )
[*]    (prompt
[*]      (strcat
[*]      (slmsg " 选到" " 選到" " Select")
[*]      (itoa (sslength s))
[*]      (slmsg "个" "個" "num")
[*]      sty
[*]      (slmsg "消去" "消去" "delete")
[*]      (itoa nm)
[*]      (slmsg "个" "個" "num")
[*]      )
[*]    )
[*])
[*];;主程序开始-------------
[*](setq e_lst (sysvar '("osmode" "cmdecho")))
[*](setvar "cmdecho" 0)
[*](setvar "OSMODE" 0)
[*](setq sline (ssadd) sarc (ssadd))
[*](repeat (setq n (sslength s))
[*]    (setq enam (ssname s (setq n (1- n))))
[*]    (setq tp (dxf1 enam 0))
[*]    (cond
[*]      ((= tp "LINE")
[*]      (ssadd enam sline)
[*]      )
[*]      ((= tp "ARC")
[*]      (ssadd enam sarc)
[*]      )
[*]    )
[*])
[*](if (> (sslength sline) 1) (slundup sline "line"))
[*](if (> (sslength sarc) 1) (slundup sarc "arc"))
[*](mapcar 'eval e_lst)
[*](princ)
[*])
[*];;删除重复的多段线、重合点、共线点------(一级)--------
[*](defun unduppl (ss / num i j lst lstx lsty lstx1 lsty1 ress tp nam e)
[*];;删除完全重合----------
[*](setq i 0 num (sslength ss) ress (ssadd));初始化变量,设置i为1的原因是方便j取值
[*](repeat (1- num);外循环开始,循环次数为多段线个数减1
[*]    (setq lst (get-pl-pt (ssname ss i)))
[*]    (setq lstx (mapcar 'car (vl-sort lst '(lambda (a b) (< (car a) (car b))))));按照X坐标从小到大排序并提取X坐标组成表
[*]    (setq lsty (mapcar 'cadr (vl-sort lst '(lambda (a b) (< (cadr a) (cadr b))))));按照Y坐标从小到大排序并提取Y坐标组成表
[*]    (setq i (1+ i))
[*]    (setq j i)   ;j的值为i
[*]    (repeat (- num i);内循坏开始,循坏次数为多段线个数减去i
[*]      (setq nam (ssname ss j))
[*]      (setq lst1 (get-pl-pt nam))
[*]      (setq lstx1 (mapcar 'car (vl-sort lst1 '(lambda (a b) (< (car a) (car b))))))
[*]      (setq lsty1 (mapcar 'cadr (vl-sort lst1 '(lambda (a b) (< (cadr a) (cadr b))))))
[*]      (if (and (equal lstx lstx1 1e-5) (equal lsty lsty1 1e-5)) ;对比两个X和两个Y的表看是否一致,一致就删除
[*]      (ssadd nam ress)
[*]      )
[*]      (setq j (1+ j))
[*]    )
[*])
[*](if ress
[*]    (progn
[*]      (setq ss (ssdiff ss ress)) ;;差集
[*]      (if (> (sslength ress) 0) (sl:-erase ress))
[*]      (prompt
[*]      (strcat
[*]          (slmsg "||选到" "||選到" "||Select")
[*]          (itoa num)
[*]          (slmsg "条多段线,消去完全重合->" "條多段線,消去完全重合->" "num Polylines,Erase Full Coincidence->")
[*]          (itoa (sslength ress))
[*]          (slmsg "个" "個" "num")
[*]      )
[*]      )
[*]    )
[*])
[*](setq e (entlast))
[*](slexpline ss);;->出口，线型实体3点以上者，炸开单线集成，宽度不变
[*](setq ss (last_ent e))
[*];;删除重合点、共线点-------
[*](repeat (setq i (sslength ss))
[*]    (setq nam (ssname ss (setq i (1- i))) tp (dxf1 nam 0))
[*]    (cond
[*]      ((= tp "LWPOLYLINE");;->出口，删除二维多段线重合点，共线点
[*]      (x@-delvx nam nil nil)
[*]      )
[*]      ((= tp "POLYLINE");;->出口，删除三维多段线重复点
[*]      (dump2dPoly nam)
[*]      )
[*]    )
[*])
[*])
[*];;删除重块--------(一级)-------
[*](defun congfukuai (ss / i pt10 sspt10 nam ssnam n ss1 ss88 ssn ssn1 u)
[*](setq u 0 ss88 (ssadd))
[*](repeat (sslength ss)
[*]    (setq ssn (ssname ss u))
[*]    (ssadd ssn ss88)
[*]    (setq u (1+ u))
[*])
[*](setq n 0 ss1 (ssadd))
[*](repeat (sslength ss)
[*]    (setq ssn (ssname ss n))
[*]    (setq pt10 (dxf1 ssn 10))
[*]    (setq nam (dxf1 ssn 2))
[*]    (setq i 0)
[*]    (ssdel ssn ss88)
[*]    (repeat (sslength ss88)
[*]      (setq ssn1 (ssname ss88 i))
[*]      (setq sspt10 (dxf1 ssn1 10))
[*]      (setq ssnam (dxf1 ssn1 2))
[*]      (if (and (< (distance pt10 sspt10) (* slbl 0.5)) (wcmatch nam ssnam))
[*]      (ssadd ssn1 ss1)
[*]      )
[*]      (setq i (1+ i))
[*]    )
[*]    (setq n (1+ n))
[*])
[*](setq n (sslength ss1))
[*](sl:-erase ss1)
[*](prompt
[*]    (strcat
[*]      (slmsg "||选到" "||選到" "||Select")
[*]      (itoa (sslength ss))
[*]      (slmsg "个图块,消去->" "個圖塊,消去->" "num blk,delete->")
[*]      (rtos n 2 0)
[*]      (slmsg "个重块!" "個重塊!" "num overlap blk!")
[*]    )
[*])
[*])
[*];;删除重叠文字------(一级)-------
[*](defun deladtxt (ss / enam u ss88 n ss1 en_data dxfl dxf10 dxf101 dxf11 dxf40 dxf401 i)
[*](setq u 0 ss88 (ssadd))
[*](repeat (sslength ss)
[*]    (setq enam (ssname ss u))
[*]    (ssadd enam ss88)
[*]    (setq u (1+ u))
[*])
[*](setq n 0 ss1 (ssadd))
[*](repeat (sslength ss)
[*]    (setq enam (ssname ss n))
[*]    (setq en_data (entget enam))
[*]    (setq dxf10 (dxf1 en_data 10) dxf40 (dxf1 en_data 40) dxfl (dxf1 en_data 1))
[*]    (ssdel enam ss88)
[*]    (setq i 0)
[*]    (repeat (sslength ss88)
[*]      (setq en1 (ssname ss88 i))
[*]      (setq en_data (entget en1))
[*]      (setq dxf101 (dxf1 en_data 10) dxf401 (dxf1 en_data 40) dxf11 (dxf1 en_data 1))
[*]      (if (and (equal dxf10 dxf101) (equal dxf40 dxf401) (= dxfl dxf11))
[*]      (ssadd en1 ss1)
[*]      )
[*]      (setq i (1+ i))
[*]    )
[*]    (setq n (1+ n))
[*])
[*](setq n (sslength ss1))
[*](sl:-erase ss1)
[*](prompt
[*]    (strcat
[*]      (slmsg "||选到" "||選到" "||Select")
[*]      (itoa (sslength ss))
[*]      (slmsg "个文字,消去->" "個文字,消去->" "num txt,delete->")
[*]      (rtos n 2 0)
[*]      (slmsg "个重叠文字!" "個重疊文字!" "num overlap txt!")
[*]    )
[*])
[*](princ)
[*])
[*];删除相同直径的圆(全图)-----(一级)------
[*];;s:circle 选择集
[*](defun undup-cir (s / nm m n ss nam enam1 cpt1 r1 kk)
[*](setq nm 0 kk (itoa (sslength s)))
[*](repeat (setq n (sslength s))
[*]    (setq enam1 (ssname s (setq n (1- n))))
[*]    (setq cpt1 (dxf1 enam1 10) r1 (dxf1 enam1 40))
[*]    (if (setq ss (ssget "x" (list (cons 0 "circle") (cons 10 cpt1) (cons 40 r1))))
[*]      (progn
[*]      (ssdel enam1 ss)
[*]      (repeat (setq m (sslength ss))
[*]          (setq nam (ssname ss (setq m (1- m))))
[*]          (if (not (ssmemb nam s)) (ssdel nam ss))
[*]      )
[*]      (sl:-erase ss)
[*]      (setq nm (+ nm (sslength ss)))
[*]      )
[*]    )
[*])
[*](prompt
[*]    (strcat
[*]      (slmsg "\n 选到" "\n 選到" "\n Select")
[*]      kk
[*]      (slmsg "个圆" "個圓" "num circle")
[*]      (slmsg "消去->" "消去->" "delete->")
[*]      (itoa nm)
[*]      (slmsg "个" "個" "num")
[*]    )
[*])
[*]) ;;图元合并(删除图纸中重叠的线、圆、圆弧、块、文字)---【结束】-----

zhaoquan888 发表于 2022-11-22 20:24:52

刚好用上，多谢大师分享

尘缘一生 发表于 2022-11-22 20:40:38

更新这部分，加次线选择集的判断，防止次线为空时崩溃


[*];;删除重复的线LINE 弧 CIR----(一级)-------
[*];;s:选择集
[*](defun undup (s / ang k a a1 a2 sty sline sarc n enam tp e_lst)
[*](defun t-ang (ang k)
[*]    (rem (+ 2pi ang) k)
[*])
[*];;判断a是否在 a1至a2两点连线上----
[*](defun on_ent (a a1 a2 sty)
[*]    (if (= sty "line")
[*]      (equal (+ (distance a1 a) (distance a a2)) (distance a1 a2) 0.01)
[*]      (if (> a2 a1) (>= a2 a a1) (or (<= a a2) (>= a a1)))
[*]    )
[*])
[*];;s:选择集 sty:实体类型字符串"line""arc"
[*](defun slundup (s sty / nm m n ss nam enam1 enam2 spt1 ept1 cpt1 r1 r2 spt2 ept2 cpt2 ptlis d1 d2 d3 d4)
[*]    (setq nm 0)
[*]    (if (= sty "line") ;;删除长度小于 0.01的直线
[*]      (repeat (setq n (sslength s))
[*]      (setq enam1 (ssname s (setq n (1- n))))
[*]      (setq spt1 (dxf1 enam1 10) ept1 (dxf1 enam1 11))
[*]      (if (<= (distance spt1 ept1) 0.01)
[*]          (progn (ssdel enam1 s) (entdel enam1) (setq nm (1+ nm)))
[*]      )
[*]      )
[*]    )
[*]    (repeat (setq n (sslength s)) ;合并重复线、弧
[*]      (setq enam1 (ssname s (setq n (1- n))))
[*]      (if (= sty "line")
[*]      (setq spt1 (dxf1 enam1 10) ept1 (dxf1 enam1 11))
[*]      (setq spt1 (t-ang (dxf1 enam1 50) 2pi)
[*]          ept1 (t-ang (dxf1 enam1 51) 2pi)
[*]          cpt1 (dxf1 enam1 10)
[*]          r1 (dxf1 enam1 40)
[*]      )
[*]      )
[*]      (if
[*]      (setq ss
[*]          (if (= sty "line")
[*]            (ssget
[*]            "CP"
[*]            (list
[*]                (polar spt1 (angle ept1 spt1) (* SLBL 0.2))
[*]                (polar ept1 (- (angle spt1 ept1) pi4) (* SLBL 0.25))
[*]                (polar ept1 (+ (angle spt1 ept1) pi4) (* SLBL 0.25))
[*]            )
[*]            '((0 . "LINE"))
[*]            )
[*]            (ssget "X" (list (cons 0 "ARC") (cons 10 cpt1) (cons 40 r1)))
[*]          )
[*]      )
[*]      (progn
[*]          (ssdel enam1 ss) ;;次选择集先删除主线
[*]          (if (> (sslength ss) 0) ;确保ss存在实体
[*]            (progn
[*]            (repeat (setq m (sslength ss))
[*]                (setq nam (ssname ss (setq m (1- m))))
[*]                (if (not (ssmemb nam s)) (ssdel nam ss)) ;;如果主选择集都没有，选择集不交差，删除次选择集实体
[*]            ) ;以上确保 主集S 次集 SS 正确
[*]            (if (> (sslength ss) 0) ;确保ss存在实体
[*]                (repeat (setq m (sslength ss))
[*]                  (setq enam2 (ssname ss (setq m (1- m))))
[*]                  (if (= sty "line")
[*]                  (setq spt2 (dxf1 enam2 10) ept2 (dxf1 enam2 11))
[*]                  (setq spt2 (t-ang (dxf1 enam2 50) 2pi)
[*]                      ept2 (t-ang (dxf1 enam2 51) 2pi)
[*]                      cpt2 (dxf1 enam2 10)
[*]                      r2 (dxf1 enam2 40)
[*]                  )
[*]                  )
[*]                  (cond
[*]                  ((and (on_ent spt2 spt1 ept1 sty) (on_ent ept2 spt1 ept1 sty));;次线落在主线上
[*]                      (ssdel enam2 ss) (entdel enam2)   ;;删除次线
[*]                  )
[*]                  ((and (on_ent spt1 spt2 ept2 sty) (on_ent ept1 spt2 ept2 sty)) ;;主线落在次线上
[*]                      (entdel enam1)   ;;删除主线
[*]                      (setq enam1 enam2 spt1 spt2 ept1 ept2);;次线转为主线
[*]                      (if (= sty "arc")
[*]                        (setq cpt1 cpt2 r1 r2)
[*]                      )
[*]                  )
[*]                  ((and
[*]                     (if (= sty "line") (equal (angle spt1 ept1) (angle spt2 ept2) 0.001)) ;;平行
[*]                     (or (on_ent spt2 spt1 ept1 sty) (on_ent ept2 spt1 ept1 sty)) ;;且一点在线上
[*]                     )
[*]                      (ssdel enam2 ss) (entdel enam2)   ;;删除次线
[*]                      (if (= sty "line")
[*]                        (progn
[*]                        (if (on_ent spt2 spt1 ept1 sty)
[*]                            (setq spt2 ept2)
[*]                        )
[*]                        (if (> (distance spt1 spt2) (distance ept1 spt2))
[*]                            (progn (sl_subupd enam1 11 spt2) (setq ept1 spt2))
[*]                            (progn (sl_subupd enam1 10 spt2) (setq spt1 spt2))
[*]                        )
[*]                        )
[*]                        (if (on_ent spt2 spt1 ept1 sty)
[*]                        (progn (sl_subupd enam1 51 ept2) (setq ept1 ept2))
[*]                        (progn (sl_subupd enam1 50 spt2) (setq spt1 spt2))
[*]                        )
[*]                      )
[*]                  )
[*]                  ((and
[*]                     (= sty "line")
[*]                     (= (sl:pts-onLine (list spt1 ept1 spt2 ept2)) t) ;共线
[*]                     )
[*]                      (setq d1 (distance spt1 spt2))
[*]                      (setq d2 (distance spt1 ept2))
[*]                      (setq d3 (distance ept1 spt2))
[*]                      (setq d4 (distance ept1 ept2))
[*]                      (if (and (< (min d1 d2 d3 d4) (* SLBL 0.1)))
[*]                        (progn
[*]                        (setq ptlis (order-pt (list spt1 ept1 spt2 ept2)))
[*]                        (ssdel enam2 ss) (entdel enam2)   ;;删除次线
[*]                        (sl_subupd enam1 10 (car ptlis))
[*]                        (setq spt1 (car ptlis)) ;下次扩展延伸选择用
[*]                        (sl_subupd enam1 11 (last ptlis))
[*]                        (setq ept1 (last ptlis)) ;下次扩展延伸选择用
[*]                        )
[*]                      )
[*]                  )
[*]                  (T (setq nm (1- nm)))
[*]                  )
[*]                  (setq nm (1+ nm))
[*]                );end repeat
[*]            );if
[*]            )
[*]          )
[*]      )
[*]      )
[*]    )
[*]    (prompt
[*]      (strcat
[*]      (slmsg " 选到" " 選到" " Select")
[*]      (itoa (sslength s))
[*]      (slmsg "个" "個" "num")
[*]      sty
[*]      (slmsg "消去" "消去" "delete")
[*]      (itoa nm)
[*]      (slmsg "个" "個" "num")
[*]      )
[*]    )
[*])
[*];;主程序开始-------------
[*](setq e_lst (sysvar '("osmode" "cmdecho")))
[*](setvar "cmdecho" 0)
[*](setvar "OSMODE" 0)
[*](command "_.ucs" "")
[*](setq sline (ssadd) sarc (ssadd))
[*](repeat (setq n (sslength s))
[*]    (setq enam (ssname s (setq n (1- n))))
[*]    (setq tp (dxf1 enam 0))
[*]    (cond
[*]      ((= tp "LINE")
[*]      (ssadd enam sline)
[*]      )
[*]      ((= tp "ARC")
[*]      (ssadd enam sarc)
[*]      )
[*]    )
[*])
[*](if (> (sslength sline) 1) (slundup sline "line"))
[*](if (> (sslength sarc) 1) (slundup sarc "arc"))
[*](mapcar 'eval e_lst)
[*](princ)
[*])

baby绑定命运线 发表于 2022-11-23 09:00:17

支持一下.....

尘缘一生 发表于 2022-11-23 09:11:56

再次改写



[*];;删除重复的线LINE 弧 CIR----(一级)-------
[*];;s:选择集
[*](defun undup (s / ang k a a1 a2 sty sline sarc n enam tp e_lst)
[*](defun t-ang (ang k)
[*]    (rem (+ 2pi ang) k)
[*])
[*];;判断a是否在 a1至a2两点连线上
[*](defun on_ent (a a1 a2 sty)
[*]    (if (= sty "line")
[*]      (equal (+ (distance a1 a) (distance a a2)) (distance a1 a2) 0.01)
[*]      (if (> a2 a1) (>= a2 a a1) (or (<= a a2) (>= a a1)))
[*]    )
[*])
[*];;s:选择集 sty:实体类型字符串"line""arc"
[*](defun slundup (s sty / nm len0 m n ss nam enam1 enam2 spt1 ept1 cpt1 r1 r2 spt2 ept2 cpt2 ptlis d1 d2 d3 d4)
[*]    (setq nm 0 len0 (sslength s))
[*]    (if (= sty "line") ;;删除长度小于 0.01的直线
[*]      (repeat (setq n (sslength s))
[*]      (setq enam1 (ssname s (setq n (1- n))))
[*]      (setq spt1 (dxf1 enam1 10) ept1 (dxf1 enam1 11))
[*]      (if (<= (distance spt1 ept1) 0.01)
[*]          (progn (ssdel enam1 s) (entdel enam1) (setq nm (1+ nm)))
[*]      )
[*]      )
[*]    )
[*]    (repeat (setq n (sslength s)) ;合并重复线、弧
[*]      (setq enam1 (ssname s (setq n (1- n))))
[*]      (if (= sty "line")
[*]      (setq spt1 (dxf1 enam1 10) ept1 (dxf1 enam1 11))
[*]      (setq
[*]          spt1 (t-ang (dxf1 enam1 50) 2pi)
[*]          ept1 (t-ang (dxf1 enam1 51) 2pi)
[*]          cpt1 (dxf1 enam1 10)
[*]          r1 (dxf1 enam1 40)
[*]      )
[*]      )
[*]      (if
[*]      (setq ss
[*]          (if (= sty "line")
[*]            (ssget
[*]            "CP"
[*]            (list
[*]                (polar spt1 (angle ept1 spt1) (* SLBL 2))
[*]                (polar ept1 (- (angle spt1 ept1) pi4) (* SLBL 2.5))
[*]                (polar ept1 (+ (angle spt1 ept1) pi4) (* SLBL 2.5))
[*]            )
[*]            '((0 . "LINE"))
[*]            )
[*]            (ssget "X" (list (cons 0 "ARC") (cons 10 cpt1) (cons 40 r1)))
[*]          )
[*]      )
[*]      (progn
[*]          (ssdel enam1 ss) ;;次选择集先删除主线
[*]          (if (> (sslength ss) 0) ;确保ss存在实体
[*]            (progn
[*]            (repeat (setq m (sslength ss))
[*]                (setq nam (ssname ss (setq m (1- m))))
[*]                (if (not (ssmemb nam s)) (ssdel nam ss)) ;;如果主选择集都没有，选择集不交差，删除次选择集实体
[*]            ) ;以上确保 主集S 次集 SS 正确
[*]            (if (> (sslength ss) 0) ;确保ss存在实体
[*]                (repeat (setq m (sslength ss))
[*]                  (setq enam2 (ssname ss (setq m (1- m))))
[*]                  (if (= sty "line")
[*]                  (setq spt2 (dxf1 enam2 10) ept2 (dxf1 enam2 11))
[*]                  (setq spt2 (t-ang (dxf1 enam2 50) 2pi)
[*]                      ept2 (t-ang (dxf1 enam2 51) 2pi)
[*]                      cpt2 (dxf1 enam2 10)
[*]                      r2 (dxf1 enam2 40)
[*]                  )
[*]                  )
[*]                  (cond
[*]                  ((and (on_ent spt2 spt1 ept1 sty) (on_ent ept2 spt1 ept1 sty));;次线落在主线上
[*]                      (setq ptlis (order-pt (list spt1 ept1 spt2 ept2)))
[*]                      (ssdel enam2 ss) (entdel enam2)   ;;删除次线
[*]                      (if (ssmemb enam2 s) ;如果次线也是主线选择集之一
[*]                        (progn
[*]                        (ssdel enam2 s)
[*]                        (setq nm (1+ nm))
[*]                        )
[*]                      )
[*]                      (sl_subupd enam1 10 (car ptlis))
[*]                      (setq spt1 (car ptlis)) ;下次扩展延伸选择用
[*]                      (sl_subupd enam1 11 (last ptlis))
[*]                      (setq ept1 (last ptlis)) ;下次扩展延伸选择用
[*]                  )
[*]                  ((and (on_ent spt1 spt2 ept2 sty) (on_ent ept1 spt2 ept2 sty)) ;;主线落在次线上
[*]                      (setq ptlis (order-pt (list spt1 ept1 spt2 ept2)))
[*]                      (ssdel enam2 ss)
[*]                      (if (ssmemb enam2 s) ;如果次线也是主线选择集之一
[*]                        (progn
[*]                        (ssdel enam2 s)
[*]                        (setq nm (1+ nm))
[*]                        )
[*]                      )
[*]                      (entdel enam2)   ;;删除次线
[*]                      (sl_subupd enam1 10 (car ptlis))
[*]                      (setq spt1 (car ptlis)) ;下次扩展延伸选择用
[*]                      (sl_subupd enam1 11 (last ptlis))
[*]                      (setq ept1 (last ptlis)) ;下次扩展延伸选择用
[*]                      (if (= sty "arc")
[*]                        (setq cpt1 cpt2 r1 r2)
[*]                      )
[*]                  )
[*]                  ((and
[*]                     (if (= sty "line") (equal (angle spt1 ept1) (angle spt2 ept2) 0.001)) ;;平行
[*]                     (or (on_ent spt2 spt1 ept1 sty) (on_ent ept2 spt1 ept1 sty)) ;;且一点在线上
[*]                     )
[*]                      (ssdel enam2 ss)
[*]                      (if (ssmemb enam2 s) ;如果次线也是主线选择集之一
[*]                        (progn
[*]                        (ssdel enam2 s)
[*]                        (setq nm (1+ nm))
[*]                        )
[*]                      )
[*]                      (entdel enam2)   ;;删除次线
[*]                      (if (= sty "line")
[*]                        (progn
[*]                        (if (on_ent spt2 spt1 ept1 sty)
[*]                            (setq spt2 ept2)
[*]                        )
[*]                        (if (> (distance spt1 spt2) (distance ept1 spt2))
[*]                            (progn (sl_subupd enam1 11 spt2) (setq ept1 spt2))
[*]                            (progn (sl_subupd enam1 10 spt2) (setq spt1 spt2))
[*]                        )
[*]                        )
[*]                        (if (on_ent spt2 spt1 ept1 sty)
[*]                        (progn (sl_subupd enam1 51 ept2) (setq ept1 ept2))
[*]                        (progn (sl_subupd enam1 50 spt2) (setq spt1 spt2))
[*]                        )
[*]                      )
[*]                  )
[*]                  ((and
[*]                     (= sty "line")
[*]                     (= (sl:pts-onLine (list spt1 ept1 spt2 ept2)) t) ;共线
[*]                     (= (on_ent spt2 spt1 ept1 sty) nil) ;次线短点1不在主线
[*]                     (= (on_ent ept2 spt1 ept1 sty) nil) ;次线短点2也不在主线
[*]                     )
[*]                      (setq d1 (distance spt1 spt2))
[*]                      (setq d2 (distance spt1 ept2))
[*]                      (setq d3 (distance ept1 spt2))
[*]                      (setq d4 (distance ept1 ept2))
[*]                      (if (and (< (min d1 d2 d3 d4) (* SLBL 0.1)))
[*]                        (progn
[*]                        (setq ptlis (order-pt (list spt1 ept1 spt2 ept2)))
[*]                        (ssdel enam2 ss)
[*]                        (if (ssmemb enam2 s) ;如果次线也是主线选择集之一
[*]                            (progn
[*]                              (ssdel enam2 s)
[*]                              (setq nm (1+ nm))
[*]                            )
[*]                        )
[*]                        (entdel enam2)   ;;删除次线
[*]                        (sl_subupd enam1 10 (car ptlis))
[*]                        (setq spt1 (car ptlis)) ;下次扩展延伸选择用
[*]                        (sl_subupd enam1 11 (last ptlis))
[*]                        (setq ept1 (last ptlis)) ;下次扩展延伸选择用
[*]                        )
[*]                      )
[*]                  )
[*]                  )
[*]                );end repeat
[*]            );if
[*]            )
[*]          )
[*]      )
[*]      )
[*]    )
[*]    (prompt
[*]      (strcat
[*]      (slmsg " 处理" " 處理" " Delete Merge")
[*]      (itoa len0)
[*]      (slmsg "个" "個" "num")
[*]      sty
[*]      (slmsg "消去" "消去" "delete")
[*]      (itoa nm)
[*]      (slmsg "个" "個" "num")
[*]      )
[*]    )
[*])
[*];;主程序开始-------------
[*](vl-load-com)
[*](setq e_lst (sysvar '("osmode" "cmdecho")))
[*](setvar "cmdecho" 0)
[*](setvar "OSMODE" 0)
[*](command "_.ucs" "")
[*](setq sline (ssadd) sarc (ssadd))
[*](repeat (setq n (sslength s))
[*]    (setq enam (ssname s (setq n (1- n))))
[*]    (setq tp (dxf1 enam 0))
[*]    (cond
[*]      ((= tp "LINE")
[*]      (ssadd enam sline)
[*]      )
[*]      ((= tp "ARC")
[*]      (ssadd enam sarc)
[*]      )
[*]    )
[*])
[*](if (> (sslength sline) 1) (slundup sline "line"))
[*](if (> (sslength sarc) 1) (slundup sarc "arc"))
[*](mapcar 'eval e_lst)
[*](princ)
[*])

tm010111 发表于 2022-11-26 16:55:39

向大师学习 厉害

andyzha 发表于 2022-12-3 17:15:30

测试了一下，好像有函数有问题，提示no function definition: SYSVAR！

muwind 发表于 2023-1-18 22:54:51

andyzha 发表于 2022-12-3 17:15
测试了一下，好像有函数有问题，提示no function definition: SYSVAR！

我没详细看，代码太多了，这个函数就是设置变量的 删除相关项目 或者自己用setvar 一个一个设置应该就可以了

zhangcan0515 发表于 2023-1-19 13:38:39

少一堆自定义函数
页: [1]
查看完整版本: 清理重复实体类集成（三领）