按填充图案样式筛选出相同填充图案？问题已解决。

★飞飛★

　　这是本人编写的程序，在两种以上的填充图案时会陷入死循环状态，不能筛选出相同的填充图案来。请教这里的高手们给修改一下，谢谢！如本程序修改完善，将对外幕墙等相关按填充图案表示材质的工程的算量将是非常有用的东西，能节省大量宝贵的时间。

(defun c:sxt () ;按填充图案样式过滤选择相同填充图案
   (setvar "cmdecho" 0)
   (princ "\n点选填充图案样式名称:")
   (setq fil (ssget (list '(0 . "HATCH"))))
   (setq sn (ssname fil 0)) ;图元名1
   (setq eg (entget sn)) ;图元名1列表
   (setq s1 (cdr (assoc 2 eg)) ) ;图元名1中填充图案名称

(setq ss (ssget (list '(0 . "HATCH"))))
(setq len (sslength ss)) ;确定选中的个数
(setq n 0)
(while (<= n (- len 1))
  (progn
   (setq sn1 (ssname ss n)) ;图元名n
   (setq eg1 (entget sn1)) ;图元名n列表
   (setq s2 (cdr (assoc 2 eg1)) ) ;图元名n中填充图案名称
   (cond ((= s2 s1)
           (command "PSELECT" sn1 "")
           (setq n (+ 1 n))
         )
   ) ;cond
  ) ;progn
);while
  (setvar "cmdecho" 1)
  (princ)
)

★飞飛★

问题已解决。在此粘贴出代码，供童鞋们工作学习使用。
如果不能亮显出对象，出现提示“未知命令PSELECT”时，解决方法是：请童鞋自己按下Ctrl+1，调出对象特性选项板，然后关闭对象特性选项板就能可以用了。

1. (defun c:sxt () ;按填充图案样式筛选出相同填充图案
   
2. (setvar "cmdecho" 0)
   
3. (princ "\n请点选需要过滤的填充图案:")
   
4. (setq fil (ssget ":E:S" (list '(0 . "HATCH"))))
   
5. (setq sn (ssname fil 0)) ;图元名1
   
6. (setq eg (entget sn)) ;图元名1列表
   
7. (setq s1 (assoc 2 eg)) ;图元名1中填充图案名称
   
8. 
   
9. (princ "\n请选择对象范围，过滤填充图案:")
   
10. (setq ss (ssget (list '(0 . "HATCH") s1)))
    
11. (setq len (sslength ss)) ;确定选中的个数
    
12. (setq n 0)
    
13. (repeat len
    
14.   (setq sn1 (ssname ss n)) ;图元名n
    
15.   (setq eg1 (entget sn1)) ;图元名n列表
    
16.   (setq s2 (cdr (assoc 2 eg1)) ) ;图元名n中填充图案名称
    
17.   (if (= s2 (cdr s1))
    
18.       (command "SELECT" ss "")
    
19.       (setq n (1+ n))
    
20.   );if
    
21. );repeat
    
22. (setvar "cmdecho" 1)
    
23. (princ)
    
24. )

(defun c:sxt () ;按填充图案样式筛选出相同填充图案<br /> (setvar "cmdecho" 0)<br /> (princ "\n请点选需要过滤的填充图案:")<br /> (setq fil (ssget ":E:S" (list '(0 . "HATCH"))))<br /> (setq sn (ssname fil 0)) ;图元名1<br /> (setq eg (entget sn)) ;图元名1列表<br /> (setq s1 (assoc 2 eg)) ;图元名1中填充图案名称<br /> <br /> (princ "\n请选择对象范围，过滤填充图案:")<br /> (setq ss (ssget (list '(0 . "HATCH") s1)))<br /> (setq len (sslength ss)) ;确定选中的个数<br /> (setq n 0)<br /> (repeat len<br />   (setq sn1 (ssname ss n)) ;图元名n<br />   (setq eg1 (entget sn1)) ;图元名n列表<br />   (setq s2 (cdr (assoc 2 eg1)) ) ;图元名n中填充图案名称<br />   (if (= s2 (cdr s1))<br />       (command "<img src="static/image/smiley/default/titter.gif" smilieid="9" border="0" alt="" />SELECT" ss "")<br />       (setq n (1+ n))<br />   );if<br /> );repeat<br /> (setvar "cmdecho" 1)<br /> (princ)<br /> )

半夜星星

;;;下面这个可以选择相同图案一起移动到指定点，你们试试吧，
(defun c:sxt () ;按填充图案样式筛选出相同填充图案
        (setvar "cmdecho" 0)
        (princ "\n点选填充样图:")
        (setq sample (ssget(list '(0 . "HATCH"))))       
       
        (while(and(princ "\n框选相同图案范围:")(setq ss (ssget (list '(0 . "HATCH") (assoc 2(entget(ssname sample 0)))))))
          (setq ptz (T-get-object-center-pt (ssname ss 0 )))
                (command "move" ss "" ptz pause)
        )       
        (setvar "cmdecho" 1)
        (princ)
)

(defun T-get-object-center-pt (name)
        (setq obj (vlax-ename->vla-object name))
        (vla-GetBoundingBox obj 't-min 't-max)
        (setq t-min (safearray-value t-min))
        (setq t-max (safearray-value t-max))
        (polar t-min (angle t-min t-max) (/ (distance t-min t-max) 2))
)

999999

★飞飛★ 发表于 2012-8-2 10:46
问题已解决。在此粘贴出代码，供童鞋们工作学习使用。
如果不能亮显出对象，出现提示“未知命令PSELECT” ...

感谢大佬分享，我这边试用了一下，您这个插件好像我选中了图案筛选后，按一下空格就又取消了选择呢，您知道是什么问题 吗

preone

(command "SELECT" sn1 "")
上句中的 PSELECT 是什么命令~？

★飞飛★

就是按Ctrl+1对象特性面板中的选择对象按钮，命令名为PSELECT，选择对象后就亮显的，之后就可以常规操作如移动，复制，删除等。

onandoff

下载了  待学习   

tianyi1230

好东西，学习了，感谢楼主

bai2000

楼主能继续开发下去，能自动计算填充面积就更好了

★飞飛★

bai2000 发表于 2012-12-26 10:04
楼主能继续开发下去，能自动计算填充面积就更好了

可以的，只是加一小段统计汇总面积的程序即可，会者不难，难点是筛选相同填充图案，呵呵

434939575

感谢大侠，今天正需要！

bai2000

顶上去，希望能等到填充面积