(07.07再更新)改进Lee-Mac李麦克大神的outline轮廓边界线程序

13763815647

给力给力给力给力给力给力给力给力给力给力给力

13763815647

大佬你好，程序很好用，咨询下，我发现这个没有闭合的多段线没闭合的距离是总图的1/15000的距离时候能自动容差闭合。
大了就不行了。这个容差有办法调吗？或者做个变量输入去调

呼呼se

这个在CAD2025中，图元中间有十字线，会出现提取错误的情况

3278

sandyvs 发表于 2024-3-31 15:54
奇了怪了，cad2020，斜的参照图块没问题，正的会报错。试了2010和2022没问题，不知道为啥

ucs,改世界

zj20190405

yjtdkj 发表于 2021-6-26 21:23
我的改进是可以消除内部多余的轮廓，
不过现在还只做到了生成的边界是多段线的情况，如果生成的边界是面域 ...

谢谢大佬，很好用。修改了下直接变遮罩
(defun c:outline ( / *error* idx sel )
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
    (if        (setq sel (ssget))
      (progn
        (setq #t0# (getvar "cdate"))
        (LM:startundo (LM:acdoc))
;;;        (LM:outline sel)
        (foreach x (LM:outline sel);;;图元列表
          (if (< (cdr (assoc 90 (entget x))) 3)
            (entdel x)
            (progn
              (vl-cmdf "WIPEOUT" "p" x "y")
              (vl-cmdf "draworder" (entlast) "" "f")
            )
          )
        )
        (princ
          (strcat "\n耗时："
                  (rtos (* 1000000 (- (getvar "cdate") #t0#) 2 3))
                  "秒"
          )
        )       
;;;        (initget "Yes No")
;;;        (if (/=        "No"
;;;                (getkword
;;;                  "\nErase original objects? [Yes/No] <Yes>: "
;;;                )
;;;            )
;;;          (repeat (setq idx (sslength sel))
;;;            (entdel (ssname sel (setq idx (1- idx))))
;;;          )
;;;        )
        (LM:endundo (LM:acdoc))
      )
    )
    (princ)
)