有没有LISP检查哪些PLINE没有闭合，亮显没有闭合地方

yucpp

CAD83 发表于 2011-3-10 15:07
能否加上选择对象一个，也可是多个，框选择这样好用好多，哪位帮再了改下，

帮你改了一个，去掉"X"就可以了

;;检查多段线是否闭合，在没有闭合的地方画个圈
;;by ZZXXQQ mjtd.com
(defun c:tt ()
  (setvar "CMDECHO" 0)
  (if (setq ss (ssget '((0 . "LWPOLYLINE") (70 . 0))))
    (progn
      (setq i 0)
      (repeat (sslength ss)
        (setq ent (entget (ssname ss i))
              pt1 (cdr (assoc 10 ent))
              pt2 (cdr (assoc 10 (reverse ent)))
              r          (* (getvar "DIMSCALE") 2)
        )
        (command ".CIRCLE" pt1 r ".CIRCLE" pt2 r)
        (setq i (1+ i))
      )
    )
  )
  (setvar "CMDECHO" 1)
  (princ)
)

zxjing

2. ;16:02 2011-3-10  zxjing    修改Z版程序 2011-3-09 20:26
   
3. ;向Z版学习
   
4. (defun HJSZ ;|环境设置|;   ()
   
5.   (setq cmd_bak (getvar "cmdecho"))
   
6.   (setq os_bak (getvar "osmode"))
   
7.   (setq lay_bak (getvar "clayer"))
   
8.   (setvar "cmdecho" 0)
   
9.   (setvar "osmode" 0)
   
10.   (princ)
    
11. )
    
12. 
    
13. (defun HFHJSZ ;|恢复环境设置|;         ()
    
14.   (setvar "cmdecho" cmd_bak)
    
15.   (setvar "osmode" os_bak)
    
16.   (setvar "clayer" lay_bak)
    
17.   (princ)
    
18. )
    
19. 
    
20. (defun c:tt ()
    
21. (HJSZ)
    
22.   (if (= (tblobjname "layer" "0-未闭合") nil)
    
23.     (command "-layer" "m" "0-未闭合" "c" "6" "" "")
    
24.       (setvar "clayer" "0-未闭合")
    
25.   )
    
26. (if (setq ss (ssget  '((0 . "LWPOLYLINE") (70 . 0))))
    
27.     (progn
    
28.       (setq i 0)
    
29.       (repeat (sslength ss)
    
30.         (setq ent (entget (ssname ss i))
    
31.               pt1 (cdr (assoc 10 ent))
    
32.               pt2 (cdr (assoc 10 (reverse ent)))
    
33.               r          (* (getvar "DIMSCALE") 2)
    
34.         )
    
35.         (command ".CIRCLE" pt1 r ".CIRCLE" pt2 r)
    
36.         (setq i (1+ i))
    
37.       )
    
38.     )
    
39.   )
    
40.   
    
41. ;;;  (if (setq ss (ssget "X" '((0 . "LWPOLYLINE") (70 . 0))))
    
42. ;;;    (progn
    
43. ;;;      (setq i 0)
    
44. ;;;      (repeat (sslength ss)
    
45. ;;;        (setq ent (entget (ssname ss i))
    
46. ;;;              pt1 (cdr (assoc 10 ent))
    
47. ;;;              pt2 (cdr (assoc 10 (reverse ent)))
    
48. ;;;              r          (* (getvar "DIMSCALE") 2)
    
49. ;;;        )
    
50. ;;;        (command ".CIRCLE" pt1 r ".CIRCLE" pt2 r)
    
51. ;;;        (setq i (1+ i))
    
52. ;;;      )
    
53. ;;;    )
    
54. ;;;  )
    
55. (HFHJSZ)
    
56. )
    
57. 
    
58. 
    
59. 
    

;16:02 2011-3-10  zxjing    修改Z版程序 2011-3-09 20:26<br /> ;向Z版学习<br /> (defun HJSZ ;|环境设置|;   ()<br />   (setq cmd_bak (getvar "cmdecho"))<br />   (setq os_bak (getvar "osmode"))<br />   (setq lay_bak (getvar "clayer"))<br />   (setvar "cmdecho" 0)<br />   (setvar "osmode" 0)<br />   (princ)<br /> )<br /> <br /> (defun HFHJSZ ;|恢复环境设置|;         ()<br />   (setvar "cmdecho" cmd_bak)<br />   (setvar "osmode" os_bak)<br />   (setvar "clayer" lay_bak)<br />   (princ)<br /> )<br /> <br /> (defun c:tt ()<br /> (HJSZ)<br />   (if (= (tblobjname "layer" "0-未闭合") nil)<br />     (command "-layer" "m" "0-未闭合" "c" "6" "" "")<br />       (setvar "clayer" "0-未闭合")<br />   )<br /> (if (setq ss (ssget  '((0 . "LWPOLYLINE") (70 . 0))))<br />     (progn<br />       (setq i 0)<br />       (repeat (sslength ss)<br />         (setq ent (entget (ssname ss i))<br />               pt1 (cdr (assoc 10 ent))<br />               pt2 (cdr (assoc 10 (reverse ent)))<br />               r          (* (getvar "DIMSCALE") 2)<br />         )<br />         (command ".CIRCLE" pt1 r ".CIRCLE" pt2 r)<br />         (setq i (1+ i))<br />       )<br />     )<br />   )<br />   <br /> ;;;  (if (setq ss (ssget "X" '((0 . "LWPOLYLINE") (70 . 0))))<br /> ;;;    (progn<br /> ;;;      (setq i 0)<br /> ;;;      (repeat (sslength ss)<br /> ;;;        (setq ent (entget (ssname ss i))<br /> ;;;              pt1 (cdr (assoc 10 ent))<br /> ;;;              pt2 (cdr (assoc 10 (reverse ent)))<br /> ;;;              r          (* (getvar "DIMSCALE") 2)<br /> ;;;        )<br /> ;;;        (command ".CIRCLE" pt1 r ".CIRCLE" pt2 r)<br /> ;;;        (setq i (1+ i))<br /> ;;;      )<br /> ;;;    )<br /> ;;;  )<br /> (HFHJSZ)<br /> )<br /> <br /> <br /> <br />

zxjing

回复 CAD83 的帖子

(ssget "X" '((0 . "LWPOLYLINE") (70 . 0))))
只要去掉那个 "X",好像就可以了
12楼那个应该可以直接用 了,你试试

zxjing

回复 cxs259 的帖子

可以设置圈圈画在专门的一层上,不想要了 的时候将其删除就可以了,参12楼程序

CAD83

呵。世上还是有好多好心人的，谢了，

lisp爱好者

看不到！发帖要大于五，pe合并后怎么查的？

wsjking

看不到。。哎

xyp1964

461045462

谢谢楼上的分享
下来试试学习学习

yifei

好好学习CAD 一劳永逸。