查找不封闭轮廓的断点的程序，谢谢llsheng_73提供帮助！

atjsking

;程序完毕！
;查找不封闭轮廓的断点位置的，测试可以用了！

(defun c:bfb()
  (setvar "cmdecho" 0)

  (setq pt1 (getpoint "\n窗选角点: "))
  (setq pt2 (getcorner pt1 "\n另一角点: "))

  (alert "设定标记颜色默认<绿色>")
  (setq cc (acad_colordlg 3))
  (alert "设定标记圆直径默认<10>")
  (setq rc (getreal "\n指定标记圆的直径<10>："))
  (if (= rc nil) (setq rc 10))
  ;做选择集

  (setq ss1(ssget "W" pt1 pt2 '((0 . "ARC")))
       ss2(ssget "W" pt2  pt1 '((0 . "LINE")))
       ss3(ssget "W" pt1 pt2 '((0 . "SPLINE")))
       ss4(ssget "W" pt2 pt1 '((0 . "LWPOLYLINE"))))
  (setq i1 0
        i2 0
        i3 0
        i4 0)
  ;对圆弧两端做圆
  (repeat (sslength ss1)
    (setq en1zm (entget (ssname ss1 i1)))
    (setq p0 (cdr(assoc 10 en1zm)))
    (setq pl (cdr(assoc 40 en1zm)))
    (setq p1a (cdr(assoc 50 en1zm)))
    (setq p2a (cdr(assoc 51 en1zm)))
    (setq p1 (polar p0 p1a pl )
          p2 (polar p0 p2a pl ))
    (setq i1 (1+ i1))
    (entmake (list(cons 0 "CIRCLE")(cons 10 p1)(cons 40 (/ rc 2)) (cons 62 cc)))
    (entmake (list(cons 0 "CIRCLE")(cons 10 p2)(cons 40 (/ rc 2)) (cons 62 cc)))
    )
     ;对直线两端做圆
  (repeat (sslength ss2)
    (setq en2zm (entget (ssname ss2 i2)))
    (setq p3 (cdr (assoc 10 en2zm ))
          p4 (cdr (assoc 11 en2zm )))
    (setq i2 (1+ i2))
    (entmake (list(cons 0 "CIRCLE")(cons 10 p3)(cons 40 (/ rc 2)) (cons 62 cc)))
    (entmake (list(cons 0 "CIRCLE")(cons 10 p4)(cons 40 (/ rc 2)) (cons 62 cc)))
   )
    ;对曲线两端做圆
  (repeat (sslength ss3)
    (setq en3zm (entget (ssname ss3 i3)))
    (setq p5 (cdr (assoc 10 en3zm ))
          p6 (cdr (assoc 10 (reverse en3zm ))))
    (setq i3 (1+ i3))
    (entmake (list(cons 0 "CIRCLE")(cons 10 p5)(cons 40 (/ rc 2)) (cons 62 cc)))
    (entmake (list(cons 0 "CIRCLE")(cons 10 p6)(cons 40 (/ rc 2)) (cons 62 cc)))
    )
    ;对多线两端做圆
    (repeat (sslength ss4)
      (setq en4zm (entget (ssname ss4 i4)))
      (setq p7 (cdr (assoc 10 en4zm ))
            p8 (cdr (assoc 10 (reverse en4zm ))))
      (setq i4 (1+ i4))
      (entmake (list(cons 0 "CIRCLE")(cons 10 p7)(cons 40 (/ rc 2)) (cons 62 cc)))
      (entmake (list(cons 0 "CIRCLE")(cons 10 p8)(cons 40 (/ rc 2)) (cons 62 cc)))
    )
;删除同心圆程序，由网友<llsheng_73>提供，此处致以谢意！

  (if (setq ss(ssget "W" pt2 pt1 '((0 . "circle")))) (progn
   (setq m(sslength ss)n 0)
   (while(< n m)
    (setq e(ssname ss n)
    n(1+ n)
    p(assoc 10(entget e))
    l n
    a nil)
    (while(< l m)
     (setq f(ssname ss l)l(1+ l)
      p1(entget f))
     (if(vl-position p p1) (progn
      (ssdel f ss)
      (entdel f)
      (setq l(1- l)
          m(1- m)
          a t)
     ))
    )
    (if a(progn
     (ssdel e ss)
     (entdel e)
     (setq n(1- n)
           m(1- m))
    ))
   )
  ))
  (princ)
)

lizhiyong_11

xinxirong 发表于 2017-9-4 14:18
LL老大做的绝对不是这么渣渣的！！没有任何意义，根本就没有判断多个对象组成的空间是否闭合，只是每 ...

对呀，我刚才使用了一下，这个程序就是画圆啊

xinxirong

LL老大做的绝对不是这么渣渣的！！没有任何意义，根本就没有判断多个对象组成的空间是否闭合，只是每个直线的两端画圆，多段线也不管闭不才闭合，直接也是两端画圆。

aihuyujian

：必须支持

cuyong123

谢谢了！看看！

llsheng_73

思路清晰，代码有优化空间，当然可能会牺牲一定的清晰性

对于虚交好象没有处理，那样会在已经封闭的虚交点上也作出标示来，能考虑下怎么处理它么？

atjsking

llsheng_73 发表于 2013-11-8 09:55
思路清晰，代码有优化空间，当然可能会牺牲一定的清晰性

对于虚交好象没有处理，那样会在已经封闭的虚交 ...

昨天晚上在家简单测试，没发现这问题，
今天到公司使用时候，确实有这情况。
新手学的不久，很多东西还没掌握，您帮做的那个程序还没研究透，里面的几个命令还没用过。
能麻烦您再帮解决下吗？谢谢大神！

llsheng_73

atjsking 发表于 2013-11-8 11:48
昨天晚上在家简单测试，没发现这问题，
今天到公司使用时候，确实有这情况。
新手学的不久，很多东西还 ...

如果要处理虚交点，得先看看线段端点处有没有除自己外的别的线(这个可以用选择集来判断)，如果有，你先前画圆的时候这个端点上就别画

所以建议增加一个判断函数,画圆之前调用它来决定要不要画圆

cshimao

如果能用就是好东东，必须支持

F4164789

支持 谢谢分享

quester

查询面积方便了！

flytoday

这个没反应~~~