下面代码哪个地方有问题

江南十笑

如下图  一些软件生成的独立基础  每个内框和外框 均为多线段  4条对角线为斜直线  所有线图层颜色均相同 现在想把所有外框切换一个图层S-BASE  我东拼西凑了下面代码  运行起来还是有问题  少量框选不起作用   全部框选 有的内外框都变图层了 请大佬看看哪里有问题

1. ;独基外轮廓
   
2. (defun c:222  ( )
   
3. 
   
4. (setq ss (ssget ' ((0 . "LWPOLYLINE")(90 . 4))))
   
5. 
   
6. 
   
7. 
   
8. (setq i 0 n (sslength ss)   )
   
9. 
   
10.   (while (< i n)  (setq  spl  (ssname ss i))
    
11.    (setq pts ( get-pline-point spl ))
    
12. (setq ssObjects (ssget "_WP" (rm-lst pts) '((0 . "LWPOLYLINE") (90 . 4))))
    
13. 
    
14.     (if ( = ssObjects nil )
    
15.     ( ssdel spl ss )
    
16.   
    
17.     )
    
18.     (setq i (1+ i))
    
19.   )
    
20. 
    
21. (command "change" ss "" "p" "la"  "S-BASE""")
    
22. 
    
23. 
    
24. 
    
25. 
    
26. (princ)
    
27. )
    
28. 
    
29. 
    
30. 
    
31. ; ssget   0   线   90  顶点个数  —>ss
    
32. ; ss ->转换为顶点加该图元地址
    
33. ; 用范围选择，判断内有无矩形
    
34. ; 无ssdel
    
35. ; 输出最终的ss
    
36. 
    
37. 
    
38. 
    
39. 
    
40. (defun get-pline-point (ent / ptlist ptlist1 re)
    
41. (setq ptlist '() ptlist1 '() n 0)
    
42. (setq ptlist (vlax-safearray->list
    
43.                 (vlax-variant-value
    
44.                   (vlax-get-property
    
45.                     (vlax-ename->vla-object ent)
    
46.                     'Coordinates
    
47.                     )
    
48.                   )
    
49.                 )
    
50.        )
    
51.   (cond
    
52.     (
    
53.      (= "LWPOLYLINE" (cdr (assoc 0 (entget ent)
    
54.                                  )
    
55.                           )
    
56.         )
    
57.     (progn
    
58.       (repeat (/ (length ptlist) 2)
    
59.         (setq ptlist1 (cons (list (nth n ptlist)
    
60.                                   (nth (setq n (1+ n)) ptlist)
    
61.                                   )
    
62.                             ptlist1)                           
    
63.               )
    
64.         (setq n (1+ n))
    
65.         )
    
66.       )
    
67.      )
    
68.     (
    
69.      (= "POLYLINE" (cdr (assoc 0 (entget ent)
    
70.                               )
    
71.                        )
    
72.      )
    
73.     (progn
    
74.       (repeat (/ (length ptlist) 3)
    
75.         (setq ptlist1 (cons (list (nth n ptlist)
    
76.                                   (nth (setq n (1+ n)) ptlist)
    
77.                                   (nth (setq n (1+ n)) ptlist)
    
78.                                   )
    
79.                             ptlist1)
    
80.               )
    
81.         (setq n (1+ n))
    
82.         )
    
83.       )
    
84.      )
    
85.     )
    
86.    
    
87. (setq re (reverse ptlist1))
    
88.   re
    
89. )
    
90. 
    
91. 
    
92. ;;;删除表中重复的子表
    
93. (defun rm-lst (ptlst)
    
94.    (setq ptlst-new '())
    
95.    (while (setq pt1 (car ptlst))
    
96.        (setq ptlst-new (cons pt1 ptlst-new)
    
97.      ptlst         (vl-remove pt1 ptlst)
    
98.        )
    
99.    )
    
100.    (setq ptlst-new (reverse ptlst-new))
     
101.    ptlst-new
     
102. )

;独基外轮廓<br /> (defun c:222  ( )<br /> <br /> (setq ss (ssget ' ((0 . "LWPOLYLINE")(90 . 4))))<br /> <br /> <br /> <br /> (setq i 0 n (sslength ss)   ) <br /> <br />   (while (< i n)  (setq  spl  (ssname ss i))<br />    (setq pts ( get-pline-point spl ))<br /> (setq ssObjects (ssget "_WP" (rm-lst pts) '((0 . "LWPOLYLINE") (90 . 4))))<br /> <br />     (if ( = ssObjects nil )<br />     ( ssdel spl ss )<br />   <br />     )<br />     (setq i (1+ i))<br />   )<br /> <br /> (command "change" ss "" "p" "la"  "S-BASE""")<br /> <br /> <br /> <br /> <br /> (princ)<br /> )<br /> <br /> <br /> <br /> ; ssget   0   线   90  顶点个数  —>ss<br /> ; ss ->转换为顶点加该图元地址<br /> ; 用范围选择，判断内有无矩形<br /> ; 无ssdel<br /> ; 输出最终的ss<br /> <br /> <br /> <br /> <br /> (defun get-pline-point (ent / ptlist ptlist1 re)<br /> (setq ptlist '() ptlist1 '() n 0)<br /> (setq ptlist (vlax-safearray->list<br />                 (vlax-variant-value<br />                   (vlax-get-property<br />                     (vlax-ename->vla-object ent)<br />                     'Coordinates<br />                     )<br />                   )<br />                 )<br />        )<br />   (cond<br />     (<br />      (= "LWPOLYLINE" (cdr (assoc 0 (entget ent)<br />                                  )<br />                           )<br />         )<br />     (progn<br />       (repeat (/ (length ptlist) 2)<br />         (setq ptlist1 (cons (list (nth n ptlist)<br />                                   (nth (setq n (1+ n)) ptlist)<br />                                   )<br />                             ptlist1)                            <br />               )<br />         (setq n (1+ n))<br />         )<br />       )<br />      )<br />     (<br />      (= "POLYLINE" (cdr (assoc 0 (entget ent)<br />                               )<br />                        )<br />      )<br />     (progn<br />       (repeat (/ (length ptlist) 3)<br />         (setq ptlist1 (cons (list (nth n ptlist)<br />                                   (nth (setq n (1+ n)) ptlist)<br />                                   (nth (setq n (1+ n)) ptlist)<br />                                   )<br />                             ptlist1)<br />               )<br />         (setq n (1+ n))<br />         )<br />       )<br />      )<br />     )<br />     <br /> (setq re (reverse ptlist1))<br />   re<br /> )<br /> <br /> <br /> ;;;删除表中重复的子表<br /> (defun rm-lst (ptlst)<br />    (setq ptlst-new '())<br />    (while (setq pt1 (car ptlst))<br />        (setq ptlst-new (cons pt1 ptlst-new)<br />      ptlst         (vl-remove pt1 ptlst)<br />        )<br />    )<br />    (setq ptlst-new (reverse ptlst-new))<br />    ptlst-new<br /> )

江南十笑

gaics

2. (defun c:222 (/ ss i n spl pts ssObjects)
   
3.   (setq ss (ssget '((0 . "LWPOLYLINE") (90 . 4))))
   
4.   (setq        i 0
   
5.         n (sslength ss)
   
6.   )
   
7.   (repeat n                                                             ;;;while改为repeat
   
8.     (setq spl (ssname ss i))
   
9.     (setq pts (get-pline-point spl))
   
10.     (setq ssObjects (ssget "_WP"
    
11.                            (rm-lst pts)
    
12.                            '((0 . "LWPOLYLINE") (90 . 4))
    
13.                     )
    
14.     )
    
15.     (if        (= ssObjects nil)
    
16.       (ssdel spl ss)
    
17.       (setq i (1+ i))                                                  ;;;ssObjects不为nil时 i+1
    
18.     )
    
19.   )
    
20.   (if (> (sslength ss) 0)
    
21.     (command "change" ss "" "p" "la" "S-BASE" "")
    
22.   )
    
23.   (princ)
    
24. )

(defun c:222 (/ ss i n spl pts ssObjects)<br />   (setq ss (ssget '((0 . "LWPOLYLINE") (90 . 4))))<br />   (setq        i 0<br />         n (sslength ss)<br />   )<br />   (repeat n                                                             ;;;while改为repeat<br />     (setq spl (ssname ss i))<br />     (setq pts (get-pline-point spl))<br />     (setq ssObjects (ssget "_WP"<br />                            (rm-lst pts)<br />                            '((0 . "LWPOLYLINE") (90 . 4))<br />                     )<br />     )<br />     (if        (= ssObjects nil)<br />       (ssdel spl ss)<br />       (setq i (1+ i))                                                  ;;;ssObjects不为nil时 i+1<br />     )<br />   )<br />   (if (> (sslength ss) 0)<br />     (command "change" ss "" "p" "la" "S-BASE" "")<br />   )<br />   (princ)<br /> )

当ssObjects为nil，从ss中删除spl，此时“i”值不能变；当ssObjects不为nil时，i+1。while改为repeat，因为“i”值可能不会大于等于“n”，就是死循环。

江南十笑

gaics 发表于 2020-9-28 14:25

当ssObjects为nil，从ss中删除spl，此时“i”值不能变；当ssObjects不为nil时 ...

谢谢大佬   已测试成功  我在仔细研究一下逻辑  

江南十笑

就是从选择集中删除一个图元 后面图元的i值会自动往前递减一个是不是这个意思

gaics

江南十笑 发表于 2020-9-28 18:35
就是从选择集中删除一个图元 后面图元的i值会自动往前递减一个是不是这个意思

是这样的。

江南十笑

好的  谢谢