明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1214|回复: 8

[提问] 请问有无能判断重叠的多段线 并且用颜色标记出

[复制链接]
发表于 2019-5-25 23:39 | 显示全部楼层 |阅读模式
有无能判断重叠多段线 并且用颜色标记出,  可以选择直接删除,或者选择用颜色标记
发表于 2019-5-26 00:26 | 显示全部楼层
本帖最后由 1291500406 于 2019-5-26 00:45 编辑

(defun c:qcf(/ dxf tang chg_ent on_ent undup os 2pi sline sarc scircle n ss ent pmt)
     (setvar "cmdecho" 0) ;指令执行过程不响应
     (PRINC "\n【必强工具箱】---删除重复(直线、圆弧或圆)功能")(PRINC)
  (defun dxf(ent i)
    (cdr (assoc i (entget ent)))
  )
  (defun tang(ang sty)
    (rem (+ 2pi ang) sty)
  )
  (defun chg_ent(ent i pt / en)
    (setq en (entget ent) en (subst (cons i pt) (assoc i en) en))
    (entmod en)
  )
  (defun on_ent(a a1 a2 sty)
    (if (= sty "直线")
      (equal (+ (distance a1 a) (distance a a2)) (distance a1 a2) 0.01)
      (if (> a2 a1) (>= a2 a a1) (or (<= a a2) (>= a a1)))
    )
  )
  (defun undup(s sty / nm m ss ent1 spt1 ept1 cpt1 r1 ent2 spt2 ept2 cpt2 r2)
    (setq n -1 nm 0)
    (if (= sty "圆")
      (repeat (sslength s)
        (setq ent1 (ssname s (setq n (1+ n))))
        (if (entget ent1)
          (progn
            (setq cpt1 (dxf ent1 10) r1 (dxf ent1 40))
            (if (setq ss (ssget "x" (list (cons 0 "circle") (cons 10 cpt1) (cons 40 r1))))
              (progn
                (ssdel ent1 ss)
                (setq m -1)
                (repeat (sslength ss)
                  (setq ent (ssname ss (setq m (1+ m))))
                  (if (not (ssmemb ent s))
                    (progn
                      (ssdel ent ss)
                      (setq m (1- m))
                    )
                  )
                )
                (command "_.erase" ss "")
                (setq nm (+ nm (sslength ss)))
              )
            )
          )
        )
      )
      (repeat (sslength s)
        (setq ent1 (ssname s (setq n (1+ n))))
        (if (entget ent1)
          (progn
            (if (= sty "直线")
              (setq spt1 (dxf ent1 10) ept1 (dxf ent1 11))
              (setq spt1 (tang (dxf ent1 50) 2pi)
                    ept1 (tang (dxf ent1 51) 2pi)
                    cpt1 (dxf ent1 10)
                    r1 (dxf ent1 40)
              )
            )
            (if (setq ss (if (= sty "直线")
                           (ssget "cp" (list (polar spt1 (angle ept1 spt1) 0.1)
                                             (polar ept1 (- (angle spt1 ept1) (/ pi 4)) 0.15)
                                             (polar ept1 (+ (angle spt1 ept1) (/ pi 4)) 0.15)
                                       ) '((0 . "line"))
                           )
                           (ssget "x" (list (cons 0 "arc") (cons 10 cpt1) (cons 40 r1)))
                         )
                )
              (progn
                (ssdel ent1 ss)
                (setq m -1)
                (repeat (sslength ss)
                  (setq ent (ssname ss (setq m (1+ m))))
                  (if (not (ssmemb ent s))
                    (progn
                      (ssdel ent ss)
                      (setq m (1- m))
                    )
                  )
                )
                (setq m -1)
                (repeat (sslength ss)
                  (setq ent2 (ssname ss (setq m (1+ m))))
                  (if (= sty "直线")
                    (setq spt2 (dxf ent2 10)
                          ept2 (dxf ent2 11)
                    )
                    (setq spt2 (tang (dxf ent2 50) 2pi)
                          ept2 (tang (dxf ent2 51) 2pi)
                          cpt2 (dxf ent2 10)
                          r2 (dxf ent2 40)
                    )
                  )
                  (cond
                    ((and (on_ent spt2 spt1 ept1 sty) (on_ent ept2 spt1 ept1 sty))
                      (entdel ent2)
                    )
                    ((and (on_ent spt1 spt2 ept2 sty) (on_ent ept1 spt2 ept2 sty))
                      (entdel ent1)
                      (setq ent1 ent2 spt1 spt2 ept1 ept2)
                      (if (= sty "圆弧")
                        (setq cpt1 cpt2 r1 r2)
                      )
                    )
                    ((and (if (= sty "直线")
                            (equal (tang (angle spt1 ept1) pi) (tang (angle spt2 ept2) pi) 0.001)
                            T
                          )
                          (or (on_ent spt2 spt1 ept1 sty) (on_ent ept2 spt1 ept1 sty))
                     )
                      (entdel ent2)
                      (if (= sty "直线")
                        (progn
                          (if (on_ent spt2 spt1 ept1 sty)
                            (setq spt2 ept2)
                          )
                          (if (> (distance spt1 spt2) (distance ept1 spt2))
                            (progn (chg_ent ent1 11 spt2) (setq ept1 spt2))
                            (progn (chg_ent ent1 10 spt2) (setq spt1 spt2))
                          )
                        )
                        (if (on_ent spt2 spt1 ept1 sty)
                          (progn (chg_ent ent1 51 ept2) (setq ept1 ept2))
                          (progn (chg_ent ent1 50 spt2) (setq spt1 spt2))
                        )
                      )
                    )
                    (T (setq nm (1- nm)))
                  )
                  (setq nm (1+ nm))
                )
              )
            )
          )
        )
      )
    )
    (prompt (strcat "-->共选到:" (itoa (sslength s)) "个" sty ",消去" (itoa nm) "个"))
  )
  (command "_.undo" "_be")
  (command "_.ucs" "")
  (setq os (getvar "osmode")
        2pi (* 2 pi)
        sline (ssadd)
        sarc (ssadd)
        scircle (ssadd)
        n -1
  )
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (prompt "\n-->请选取(直线、圆弧或圆):")
  (if (setq ss (ssget '((0 . "line,arc,circle"))))
    (progn
      (prompt "\n-->正在消除合并重复线条,请稍候...")
      (prompt "\n")
      (repeat (sslength ss)
        (setq ent (ssname ss (setq n (1+ n))))
        (cond
          ((= (dxf ent 0) "LINE") (ssadd ent sline))
          ((= (dxf ent 0) "ARC") (ssadd ent sarc))
          ((= (dxf ent 0) "CIRCLE") (ssadd ent scircle))
        )
      )
    )
  )
  (if (> (sslength sline) 1) (progn(command "change" sline "" "p" "c" "1"  "") (undup sline "直线") (setq pmt T)))
  (if (> (sslength sarc) 1) (progn (command "change" sarc "" "p" "c" "1"  "")(undup sarc "圆弧") (setq pmt T)))
  (if (> (sslength scircle) 1) (progn(command "change" scircle "" "p" "c" "1"  "") (undup scircle "圆") (setq pmt T)))
  (if (and ss (not pmt)) (prompt "\n没有重复实体!"))
  (setvar "osmode" os)
  (command "_.undo" "_e")
(PRINC))
回复 支持 2 反对 0

使用道具 举报

发表于 2019-5-26 00:46 | 显示全部楼层
本帖最后由 1291500406 于 2019-5-26 01:16 编辑

你加油,这个给你提供参考
http://bbs.mjtd.com/forum.php?mo ... ;highlight=overkill

 楼主| 发表于 2019-5-26 12:05 | 显示全部楼层
1291500406 发表于 2019-5-26 00:46
你加油,这个给你提供参考
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=178070&highlight=overkill ...

你是真的能熬夜,,凌晨一点还不睡觉
发表于 2019-5-26 14:48 | 显示全部楼层
yjpyjp 发表于 2019-5-26 12:05
你是真的能熬夜,,凌晨一点还不睡觉

我两点都没没睡
发表于 2022-7-26 10:26 | 显示全部楼层
1291500406 发表于 2019-5-26 00:26
(defun c:qcf(/ dxf tang chg_ent on_ent undup os 2pi sline sarc scircle n ss ent pmt)
     (setvar " ...

强大强大强大强大强大
发表于 2022-11-30 15:19 | 显示全部楼层
1291500406 发表于 2019-5-26 00:26
(defun c:qcf(/ dxf tang chg_ent on_ent undup os 2pi sline sarc scircle n ss ent pmt)
     (setvar " ...

请问重复的填充可以清除吗
发表于 2022-11-30 17:29 | 显示全部楼层
为啥不用express tools 的 overkill ?
发表于 2023-3-27 12:17 | 显示全部楼层
不错 ,先记下来
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 20:19 , Processed in 0.181242 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表