【已解决】程序如何跳过（或强制拉伸）不能“EXTRUDE”为“三维实体”的“自交曲线”

zxjing

一、程序功能

批量拉伸平面图形（主要是PL线）至三维实体。

具体为：把当前“打开状态”的每个图层上的图元（主要是闭合多段线）根据图层名称沿Z轴拉伸一定高度。（高度由图元所在的图层的名称“30-60m”的“-”和“m”之间的数值决定）

调用的命令为“EXTRUDE”，工具条位置为“建模工具条\拉伸命令”。

二、面临问题

程序执行至遇到不能拉伸的“自相交曲线”时，程序提示“不能扫掠或拉伸自交的曲线”并中断运行，要求“重新选择拉伸对象”。

论坛里有类似的问题，只找到两种解决思路，但是没试出来怎么用，还请大咖们不吝赐教。思路①VLISP中vl-catch-all-apply 函数；思路②(defun *error*(msg)  (princ "error: ")  (princ msg) (princ))。

三、已知条件

因为CAD的图层是按照高度分层的，所以，

①   手动“拉伸”的话，可以“选层”，然后把本层所有图元统一拉伸一个高度。手动拉伸时，不能拉伸的图元（自相交曲线）会保持不变，但只要能拉伸的图元全部都能完成拉伸。（但程序执行时遇到“自交的曲线”就会中断，并一直要求输入待拉伸的图元（但并没有退出程序，也不是程序报错））

②   剩下的“自相交曲线”可以通过工具条“拉伸”命令后面的“-presspull（按住并拖动）”命令来手动拉伸。

4、CAD版本：AutoCAD2008和AutoCAD2018

四、该问题的三种解决思路

1、 提前筛选自交曲线，不参与拉伸——目前网上找到的都不能满足需要，主要是两种情况：

①   只要是闭合的就认为是自交——（我的图元都是闭合多段线）；

②   不能把“不能拉伸的图元”判定为自交曲线。

2、 跳过自交曲线，继续执行程序——能画个圈圈标注一下就更好了。这个不会弄，请求论坛大咖帮助啊。

3、CAD2018中调用“-presspull”命令——昨晚发现AutoCAD2018的“-presspull（按住并拖动）”命令可以直接操作图元而不需要像CAD2008一样“点击图元内部的点”才可以拉伸。但是没有试出来调用的方法，一直提示“-presspull”。

五、代码

2. (defun C:PLLS ( / *error* error_bak );显示层按图层名高度 批量拉伸
   
3. (print "\n请把需要拉伸的图层独立。不允许“空图层”和不能拉伸的图元！")
   
4. 
   
5. ;;;获取打开状态的图层列表=====-=========================
   
6. 
   
7.   (setq n 1)
   
8. (while (setq lay (tblnext "layer" (not lay)))
   
9.   (if (> (cdr (assoc 62 lay)) 0)
   
10.     (if (= n 1)
    
11.       (progn (setq date (cdr (assoc 2 lay))  ) (setq n 2))
    
12. (print(setq date (strcat date " " (cdr (assoc 2 lay)))   ))
    
13.       )
    
14. ))
    
15. ;;;获取打开状态的图层列表=====-=========================
    
16. 
    
17. 
    
18. 
    
19.   
    
20.     (setq i 0)
    
21.    (setq str1 (mapcar '(lambda(x)(set(read(strcat"dl"(itoa(setq i(1+ i)))))x))(read (strcat"(" date ")"))))
    
22.    (setq n 0)   
    
23. (repeat (length (setq str1(reverse (setq str1(mapcar 'vl-princ-to-string str1)))))
    
24. (print (setq XStuceng;|显示图层|; (nth n str1)))   ;获取一个打开的图层名
    
25. 
    
26. 
    
27. (setq ss (ssget "x" (list(cons 8  XStuceng)))) ;按图层名称选择本层所有图元
    
28. (sssetfirst nil ss)
    
29. 
    
30. 
    
31. 
    
32.   
    
33. 
    
34. ;;;  获取图层名内“-”与“m”之间的数值作为拉伸的高度============
    
35. ;;;(ascii "M(-+" ) ;查询ascii码
    
36.       (setq pos (vl-string-position 45 XStuceng))
    
37.     (setq gaodu (atoi(substr XStuceng (+ pos 2) (1- (- (vl-string-position 77 XStuceng) pos)))));返回以后的字串符
    
38. ;;;  获取图层名内“-”与“m”之间的数值作为拉伸的高度============
    
39. 
    
40. 
    
41. 
    
42. 
    
43.   
    
44.   (command "layer" "s" XStuceng "")
    
45.   (setq m 0) ;序号的初值设为0
    
46. (repeat (sslength ss);重复执行ss的长度的次数，即对象的个数
    
47. (setq name (ssname ss m));得到选择集内第n个对象的图元名
    
48. ;;; (setq ent (entget name));得到该对象的图元表
    
49. 
    
50. 
    
51. 
    
52. 
    
53. 
    
54. ;;; 核心执行的“拉伸”命令在这里 ===========
    
55. (if(=(command "extrude" name "" gaodu  ) nil);这句判断好像直接执行了，一点判断作用也没有，否的情况从来没执行过
    
56. ;;;  (progn (setq ss2 (ssadd))
    
57. ;;;  (ssadd name ss2)
    
58. ;;;  (sssetfirst nil (ssadd (setq name (ssname ss (1- m))) ss2));
    
59.   (progn (setq m (1+ m))
    
60.     (princ m)
    
61.     )
    
62. 
    
63.   (progn(command "extrude" name "" gaodu  )
    
64. (setq m (1+ m))
    
65. ;;;    (setq m(+ m 100))
    
66.         )
    
67.   );if cishu_nil   ;序号M的数量加1
    
68. ;;; 核心执行的“拉伸”命令在这里 ===========
    
69. 
    
70.   
    
71.   
    
72.   )
    
73.   
    
74. (setq n (1+ n))
    
75. )
    
76. 
    
77.   (prin1)
    
78. );程序结束
    
79. 
    
80. 
    
81. 
    
82. 
    
83. (defun C:PLLS2 () ;查找批量拉伸失败的那个图元
    
84.   (command "regen")
    
85. (setq ss2 (ssadd))
    
86.   (sssetfirst nil (ssadd (setq name (ssname ss (1- m))) ss2))
    
87. )
    

(defun C:PLLS ( / *error* error_bak );显示层按图层名高度 批量拉伸<br /> (print "\n请把需要拉伸的图层独立。不允许“空图层”和不能拉伸的图元！")<br /> <br /> ;;;获取打开状态的图层列表=====-=========================<br /> <br />   (setq n 1)<br /> (while (setq lay (tblnext "layer" (not lay)))<br />   (if (> (cdr (assoc 62 lay)) 0)<br />     (if (= n 1)<br />       (progn (setq date (cdr (assoc 2 lay))  ) (setq n 2))<br /> (print(setq date (strcat date " " (cdr (assoc 2 lay)))   ))<br />       )<br /> ))<br /> ;;;获取打开状态的图层列表=====-=========================<br /> <br /> <br /> <br />   <br />     (setq i 0)<br />    (setq str1 (mapcar '(lambda(x)(set(read(strcat"dl"(itoa(setq i(1+ i)))))x))(read (strcat"(" date ")"))))<br />    (setq n 0)   <br /> (repeat (length (setq str1(reverse (setq str1(mapcar 'vl-princ-to-string str1)))))<br /> (print (setq XStuceng;|显示图层|; (nth n str1)))   ;获取一个打开的图层名<br /> <br /> <br /> (setq ss (ssget "x" (list(cons 8  XStuceng)))) ;按图层名称选择本层所有图元<br /> (sssetfirst nil ss)<br /> <br /> <br /> <br />   <br /> <br /> ;;;  获取图层名内“-”与“m”之间的数值作为拉伸的高度============<br /> ;;;(ascii "M(-+" ) ;查询ascii码<br />       (setq pos (vl-string-position 45 XStuceng))<br />     (setq gaodu (atoi(substr XStuceng (+ pos 2) (1- (- (vl-string-position 77 XStuceng) pos)))));返回以后的字串符<br /> ;;;  获取图层名内“-”与“m”之间的数值作为拉伸的高度============<br /> <br /> <br /> <br /> <br />   <br />   (command "layer" "s" XStuceng "")<br />   (setq m 0) ;序号的初值设为0<br /> (repeat (sslength ss);重复执行ss的长度的次数，即对象的个数<br /> (setq name (ssname ss m));得到选择集内第n个对象的图元名<br /> ;;; (setq ent (entget name));得到该对象的图元表<br /> <br /> <br /> <br /> <br /> <br /> ;;; 核心执行的“拉伸”命令在这里 ===========<br /> (if(=(command "extrude" name "" gaodu  ) nil);这句判断好像直接执行了，一点判断作用也没有，否的情况从来没执行过<br /> ;;;  (progn (setq ss2 (ssadd))<br /> ;;;  (ssadd name ss2)<br /> ;;;  (sssetfirst nil (ssadd (setq name (ssname ss (1- m))) ss2));<br />   (progn (setq m (1+ m))<br />     (princ m)<br />     )<br /> <br />   (progn(command "extrude" name "" gaodu  )<br /> (setq m (1+ m))<br /> ;;;    (setq m(+ m 100))<br />         )<br />   );if cishu_nil   ;序号M的数量加1<br /> ;;; 核心执行的“拉伸”命令在这里 ===========<br /> <br />   <br />   <br />   )<br />   <br /> (setq n (1+ n))<br /> )<br /> <br />   (prin1)<br /> );程序结束<br /> <br /> <br /> <br /> <br /> (defun C:PLLS2 () ;查找批量拉伸失败的那个图元<br />   (command "regen")<br /> (setq ss2 (ssadd))<br />   (sssetfirst nil (ssadd (setq name (ssname ss (1- m))) ss2))<br /> )<br />

六、实例文件

上面的这个文件下载后显示为“无效文件”，百度网盘连接为：

链接：https://pan.baidu.com/s/1Tz-cKNbXh_uoiamzJmzsfA

提取码：1234

1、文件中共有三个不能拉伸的“自交曲线”，打开线宽就可以很明显的看到。程序中断的时候用“plls2”就可以看到，但只能找到本次卡住的那一个。

2、示例文件在在三维视图下的，打开“视图”工具条即可调整视图角度，或者shift+鼠标中键。

wyl219

command 只会返回nil...

为什么要分别extrude每个图元呢?直接extrude选择集不就好了

没用过3D相关命令,我的思路是:
1.遍历图层,寻找打开状态的,图层名符合要求的图层,并从图层名(lay)中获取拉伸高度h.
2.通过(ssget "x" (list(cons 8 lay)))获取该图层下所有对象
3.通过(command "extrude" ss "" h ) 自动拉伸能拉伸的对象,这样就能实现自动跳过不能拉伸的对象.
4.重新用(ssget "x" (list (cons 0 "~3DSOLID")(cons 8 lay)))获取该图层下所有不为三维实体的对象,这次获取到的就能不能拉伸的漏网之鱼.
5.遍历选择集,在组码10插入圆.

不太理解题主的问题所在,如果是需要对图层下的对象筛选以后,排除部分图元,可以ssdel以后拉伸选择集
另外还有一个思路,对一个选择集拉伸以后,选择集还在,但是拉伸后的对象图元名不在了,因此entget会返回nil,即对选择集拉伸以后,还能获取到信息表的对象是不能拉伸被跳过的对象

zxjing

wyl219 发表于 2020-11-5 06:43
command 只会返回nil...

为什么要分别extrude每个图元呢?直接extrude选择集不就好了

好的，谢谢。

zxjing

zxjing 发表于 2020-11-5 22:07
好的，谢谢。

我再试一下选择集。第一次用选择集的时候记得是提示参数错误了。   现在想也可能是图层或别的原因导致的。现在已经排除了这些干扰，可以再试一下。谢谢提醒:P

zxjing

wyl219 发表于 2020-11-5 06:43
command 只会返回nil...

为什么要分别extrude每个图元呢?直接extrude选择集不就好了

3.通过(command "extrude" ss "" h ) 自动拉伸能拉伸的对象,这样就能实现自动跳过不能拉伸的对象.
太感谢啦，这一句完美拉伸了所有可拉伸的图元

zxjing

(defun C:PLLS ( / *error* error_bak );显示层按图层名高度 批量拉伸
(print "\n请把需要拉伸的图层独立，关闭0层。不允许“空图层”和不能拉伸的图元！")
(setq ssbnls (ssadd))
  (command "-layer"  "off" "0" "")
;;;获取打开状态的图层列表=====-=========================

  (setq n 1)
(while (setq lay (tblnext "layer" (not lay)))
  (if (> (cdr (assoc 62 lay)) 0)
    (if (= n 1)
      (progn (setq date (cdr (assoc 2 lay))  ) (setq n 2))
(print(setq date (strcat date " " (cdr (assoc 2 lay)))   ))
      )
))
;;;获取打开状态的图层列表=====-=========================



  
    (setq i 0)
   (setq str1 (mapcar '(lambda(x)(set(read(strcat"dl"(itoa(setq i(1+ i)))))x))(read (strcat"(" date ")"))))
   (setq n 0)   
(repeat (length (setq str1(reverse (setq str1(mapcar 'vl-princ-to-string str1)))))
(print (setq XStuceng;|显示图层|; (nth n str1)))   ;获取一个打开的图层名


(setq ss (ssget "x" (list(cons 8  XStuceng)))) ;按图层名称选择本层所有图元
(sssetfirst nil ss)



  

;;;  获取图层名内“-”与“m”之间的数值作为拉伸的高度============
;;;(ascii "M(-+" ) ;查询ascii码
      (setq pos (vl-string-position 45 XStuceng))
    (setq gaodu (atoi(substr XStuceng (+ pos 2) (1- (- (vl-string-position 77 XStuceng) pos)))));返回以后的字串符
;;;  获取图层名内“-”与“m”之间的数值作为拉伸的高度============




  
  (command "layer" "s" XStuceng "")

  (command "extrude" ss "" gaodu )
  
(if (/=  (setq bunenglashen (ssget "x" (list (cons 0 "~3DSOLID")(cons 8 XStuceng))))nil);选择不能拉伸的图元
   (progn (sssetfirst nil bunenglashen)
;;; (setq ssbnls (ssadd ssbnls bunenglashen))

(setq k 0)
(repeat (sslength bunenglashen)
  (setq ssbnls (ssadd (ssname bunenglashen k) ssbnls))
  (setq k (1+ k))
)
(sssetfirst nil ssbnls)
     
     ));(progn   ;if


  
(setq n (1+ n))
)

  
(sssetfirst nil ssbnls)
  (prin1)
(if (= (tblobjname "layer" "0-未不能拉伸的图元") nil)
    (command "-layer" "m" "0-未不能拉伸的图元" "c" "6" "" "")
      (setvar "clayer" "0-未不能拉伸的图元")
  )


   (setq m 0) ;序号的初值设为0
(repeat (sslength ssbnls);重复执行ss的长度的次数，即对象的个数
(setq name (ssname ssbnls m));得到选择集内第n个对象的图元名
(setq ent (entget name);得到该对象的图元表
              pt1 (cdr (assoc 10 ent))
;;;              pt2 (cdr (assoc 10 (reverse ent)))
;;;              r          (* (getvar "DIMSCALE") 2)
        )
  (command ".CIRCLE" pt1 100 )(prin1)
  (setq m (1+ m))
)
  (sssetfirst nil ssbnls)
  
);程序结束



(defun C:PLLS2 () ;查找批量拉伸失败的图元
  (command "regen")
(sssetfirst nil ssbnls)
)

zxjing

2. ;兼容AutoCAD2018，设置为拉伸后删除图元。可以多次添加新图元进行拉伸
   
3. (defun C:PLLS ( / *error* error_bak );显示层按图层名高度 批量拉伸
   
4. (alert "\n请确保①已把需要拉伸的图层独立显示；②无“空图层”；③关闭0层和无关层！")
   
5. (print "\n请把需要拉伸的图层独立，关闭0层。不允许“空图层”和不能拉伸的图元！")
   
6. (setvar "DELOBJ" -1);设置拉伸后原图元是否保留。3，默认删除； 0，保留；-1，提示是否删除
   
7. (setq ssbnls (ssadd))
   
8.   (command "-layer"  "off" "0" "")
   
9. 
   
10. (if (/= (getvar "clayer") "0-未能拉伸的图元")
    
11. (command "-layer"  "off" "0-未能拉伸的图元" "")
    
12. (command "-layer"  "off" "0-未能拉伸的图元" "y" ""))
    
13. ;;;获取打开状态的图层列表=====-=========================
    
14. 
    
15.   (setq n 1)
    
16. (while (setq lay (tblnext "layer" (not lay)))
    
17.   (if (> (cdr (assoc 62 lay)) 0)
    
18.     (if (= n 1)
    
19.       (progn (setq date (cdr (assoc 2 lay))  ) (setq n 2))
    
20. (print(setq date (strcat date " " (cdr (assoc 2 lay)))   ))
    
21.       )
    
22. ))
    
23. ;;;获取打开状态的图层列表=====-=========================
    
24. 
    
25. 
    
26. 
    
27.   
    
28.     (setq i 0)
    
29.    (setq str1 (mapcar '(lambda(x)(set(read(strcat"dl"(itoa(setq i(1+ i)))))x))(read (strcat"(" date ")"))))
    
30.    (setq n 0)   
    
31. (repeat (length (setq str1(reverse (setq str1(mapcar 'vl-princ-to-string str1)))))
    
32. (print (setq XStuceng;|显示图层|; (nth n str1)))   ;获取一个打开的图层名
    
33. 
    
34. 
    
35. (setq ss (ssget "x" (list(cons 0 "~3DSOLID")(cons 8  XStuceng)))) ;按图层名称选择本层所有图元
    
36. (sssetfirst nil ss)
    
37. 
    
38. 
    
39. 
    
40.   
    
41. 
    
42. ;;;  获取图层名内“-”与“m”之间的数值作为拉伸的高度============
    
43. ;;;(ascii "M(-+" ) ;查询ascii码
    
44.       (setq pos (vl-string-position 45 XStuceng))
    
45.     (setq gaodu (atoi(substr XStuceng (+ pos 2) (1- (- (vl-string-position 77 XStuceng) pos)))));返回以后的字串符
    
46. ;;;  获取图层名内“-”与“m”之间的数值作为拉伸的高度============
    
47. 
    
48. 
    
49. 
    
50. 
    
51.   
    
52.   (command "layer" "s" XStuceng "")
    
53. 
    
54.   (command "extrude" ss "" gaodu )
    
55.   
    
56. (if (/=  (setq bunenglashen (ssget "x" (list (cons 0 "~3DSOLID")(cons 8 XStuceng))))nil);选择不能拉伸的图元
    
57.    (progn (sssetfirst nil bunenglashen)
    
58. ;;; (setq ssbnls (ssadd ssbnls bunenglashen))
    
59. 
    
60. (setq k 0)
    
61. (repeat (sslength bunenglashen)
    
62.   (setq ssbnls (ssadd (ssname bunenglashen k) ssbnls))
    
63.   (setq k (1+ k))
    
64. )
    
65. (sssetfirst nil ssbnls)
    
66.      
    
67.      ));(progn   ;if
    
68. 
    
69. 
    
70.   
    
71. (setq n (1+ n))
    
72. )
    
73. 
    
74.   
    
75. (sssetfirst nil ssbnls)
    
76.   (prin1)
    
77. (if (= (tblobjname "layer" "0-未能拉伸的图元") nil)
    
78.     (command "-layer" "m" "0-未能拉伸的图元" "c" "6" "" "")
    
79.        (progn (setvar "clayer" "0-未能拉伸的图元")(command "-layer"  "on" "0-未能拉伸的图元" ""))
    
80.   )
    
81. 
    
82. 
    
83.    (setq m 0) ;序号的初值设为0
    
84. (repeat (sslength ssbnls);重复执行ss的长度的次数，即对象的个数
    
85. (setq name (ssname ssbnls m));得到选择集内第n个对象的图元名
    
86. (setq ent (entget name);得到该对象的图元表
    
87.         pt1 (cdr (assoc 10 ent))
    
88. ;;;        pt2 (cdr (assoc 10 (reverse ent)))
    
89. ;;;        r    (* (getvar "DIMSCALE") 2)
    
90.   )
    
91. (command ".CIRCLE" pt1 100 )(prin1)
    
92.   (setq m (1+ m))
    
93. )
    
94.   (sssetfirst nil ssbnls)
    
95.   
    
96. );程序结束
    
97. 
    
98. 
    
99. 
    
100. (defun C:PLLS2 () ;查找批量拉伸失败的图元
     
101.   (command "regen")
     
102. (sssetfirst nil ssbnls)
     
103. )
     
104. 
     
105. 
     
106. 
     
107. 
     
108. 
     
109. (defun C:PLLS3 () ;查找批量拉伸失败的那个图元
     
110.   (command "regen")
     
111. (setq ss2 (ssadd))
     
112.   (sssetfirst nil (ssadd (setq name (ssname ss (1- m))) ss2))
     
113. )
     
114. 
     

;兼容AutoCAD2018，设置为拉伸后删除图元。可以多次添加新图元进行拉伸<br /> (defun C:PLLS ( / *error* error_bak );显示层按图层名高度 批量拉伸<br /> (alert "\n请确保①已把需要拉伸的图层独立显示；②无“空图层”；③关闭0层和无关层！")<br /> (print "\n请把需要拉伸的图层独立，关闭0层。不允许“空图层”和不能拉伸的图元！")<br /> (setvar "DELOBJ" -1);设置拉伸后原图元是否保留。3，默认删除； 0，保留；-1，提示是否删除<br /> (setq ssbnls (ssadd))<br />   (command "-layer"  "off" "0" "")<br /> <br /> (if (/= (getvar "clayer") "0-未能拉伸的图元")<br /> (command "-layer"  "off" "0-未能拉伸的图元" "")<br /> (command "-layer"  "off" "0-未能拉伸的图元" "y" ""))<br /> ;;;获取打开状态的图层列表=====-=========================<br /> <br />   (setq n 1)<br /> (while (setq lay (tblnext "layer" (not lay)))<br />   (if (> (cdr (assoc 62 lay)) 0)<br />     (if (= n 1)<br />       (progn (setq date (cdr (assoc 2 lay))  ) (setq n 2))<br /> (print(setq date (strcat date " " (cdr (assoc 2 lay)))   ))<br />       )<br /> ))<br /> ;;;获取打开状态的图层列表=====-=========================<br /> <br /> <br /> <br />   <br />     (setq i 0)<br />    (setq str1 (mapcar '(lambda(x)(set(read(strcat"dl"(itoa(setq i(1+ i)))))x))(read (strcat"(" date ")"))))<br />    (setq n 0)   <br /> (repeat (length (setq str1(reverse (setq str1(mapcar 'vl-princ-to-string str1)))))<br /> (print (setq XStuceng;|显示图层|; (nth n str1)))   ;获取一个打开的图层名<br /> <br /> <br /> (setq ss (ssget "x" (list(cons 0 "~3DSOLID")(cons 8  XStuceng)))) ;按图层名称选择本层所有图元<br /> (sssetfirst nil ss)<br /> <br /> <br /> <br />   <br /> <br /> ;;;  获取图层名内“-”与“m”之间的数值作为拉伸的高度============<br /> ;;;(ascii "M(-+" ) ;查询ascii码<br />       (setq pos (vl-string-position 45 XStuceng))<br />     (setq gaodu (atoi(substr XStuceng (+ pos 2) (1- (- (vl-string-position 77 XStuceng) pos)))));返回以后的字串符<br /> ;;;  获取图层名内“-”与“m”之间的数值作为拉伸的高度============<br /> <br /> <br /> <br /> <br />   <br />   (command "layer" "s" XStuceng "")<br /> <br />   (command "extrude" ss "" gaodu )<br />   <br /> (if (/=  (setq bunenglashen (ssget "x" (list (cons 0 "~3DSOLID")(cons 8 XStuceng))))nil);选择不能拉伸的图元<br />    (progn (sssetfirst nil bunenglashen)<br /> ;;; (setq ssbnls (ssadd ssbnls bunenglashen))<br /> <br /> (setq k 0)<br /> (repeat (sslength bunenglashen)<br />   (setq ssbnls (ssadd (ssname bunenglashen k) ssbnls))<br />   (setq k (1+ k))<br /> )<br /> (sssetfirst nil ssbnls)<br />      <br />      ));(progn   ;if<br /> <br /> <br />   <br /> (setq n (1+ n))<br /> )<br /> <br />   <br /> (sssetfirst nil ssbnls)<br />   (prin1)<br /> (if (= (tblobjname "layer" "0-未能拉伸的图元") nil)<br />     (command "-layer" "m" "0-未能拉伸的图元" "c" "6" "" "")<br />        (progn (setvar "clayer" "0-未能拉伸的图元")(command "-layer"  "on" "0-未能拉伸的图元" ""))<br />   )<br /> <br /> <br />    (setq m 0) ;序号的初值设为0<br /> (repeat (sslength ssbnls);重复执行ss的长度的次数，即对象的个数<br /> (setq name (ssname ssbnls m));得到选择集内第n个对象的图元名<br /> (setq ent (entget name);得到该对象的图元表<br />         pt1 (cdr (assoc 10 ent))<br /> ;;;        pt2 (cdr (assoc 10 (reverse ent)))<br /> ;;;        r    (* (getvar "DIMSCALE") 2)<br />   )<br /> (command ".CIRCLE" pt1 100 )(prin1)<br />   (setq m (1+ m))<br /> )<br />   (sssetfirst nil ssbnls)<br />   <br /> );程序结束<br /> <br /> <br /> <br /> (defun C:PLLS2 () ;查找批量拉伸失败的图元<br />   (command "regen")<br /> (sssetfirst nil ssbnls)<br /> )<br /> <br /> <br /> <br /> <br /> <br /> (defun C:PLLS3 () ;查找批量拉伸失败的那个图元<br />   (command "regen")<br /> (setq ss2 (ssadd))<br />   (sssetfirst nil (ssadd (setq name (ssname ss (1- m))) ss2))<br /> )<br /> <br />

wyl219

(if (/= ss nil))
可以修改为 (if ss )
(if (= ss nil))
可以修改为 (if (not ss ))


可以尝试一下以下代码:
;|
说明:筛选选择集ss中未被extrude命令处理的图元并画框标注
参数:ss:要被筛选的选择集
ss2:用于存放筛选出来的图元的选择集
返回值:无,但是ss2会被修改
|;
(defun flll_ss_by_extrude(ss ss2 / entmake_CIRCLE getbox old_lay en i)
        (vl-load-com)
        (setq entmake_CIRCLE (lambda (pt r)
                                                                                                 (entmake (list '(0 . "CIRCLE")
                                                                                                                                                '(8 . "0-未能拉伸的图元") ;图层
                                                                                                                                                (cons 10 pt) ;圆心
                                                                                                                                                (cons 40 r) ;半径
                                                                                                                                        )) ));画圆的临时函数
        (setq old_lay (getvar "CLAYER"));保存当前图层
        (if (tblobjname "layer" "0-未能拉伸的图元")
                (command "-layer"  "on" "0-未能拉伸的图元" "");如果有图层打开图层
    (command "-layer" "m" "0-未能拉伸的图元" "c" "6" "" "");如果没有图层,建立图层
        )
        (setq getbox (lambda (en) ;获取对象的最小包围盒
                                                                 (vla-GetBoundingBox (vlax-ename->vla-object en) 'll 'rr)  ;得到对象的包围盒
                                                                 (list (vlax-safearray->list ll) (vlax-safearray->list rr));返回左下右上坐标
                                                         ))
        (repeat (setq i (sslength ss))
                (setq i (1- i))
                (if  (entget (setq en (ssname ss i)))
                        (progn;如果能找到信息表,说明未被处理
                                (ssadd en ss2)
                                (apply 'entmake_CIRCLE (apply '(lambda (p1 p2)
                                                                                                                                                                 (list (mapcar '(lambda (x1 x2) (+ x1 (* (- x2 x1) 0.5))) p1 p2);包围盒的中点,圆心
                                                                                                                                                                         (* 0.5 (distance p1 p2));半径r
                                                                                                                                                                 ))
                                                                                                                                 (getbox en);获取最小包围盒
                                                                                                                         ));画圆
                        )
                )
        )
        (setvar "CLAYER" old_lay);恢复保存的图层
        (princ)
)


;|
说明:示例函数
|;

(defun c:ttt ( /)
        (setq ss (ssget (list(cons 0 "~3DSOLID"))));要被拉伸的选择集
        (if(not ss2)
                (setq ss2 (ssadd)));用于存放的选择集
        (command "EXTRUDE" ss "" 100 );批量拉伸
        (flll_ss_by_extrude ss ss2)
        (sssetfirst nil ss2)
        
)
(princ)

wyl219

建议写程序的时候遵照模块化的原则,这样修改和增减功能会方便很多