各位大神，求一个输入tt选择一个或多个块后，选中图上同名称的块

664571221

各位大神，求一个输入tt选择一个或多个块后，选中图上同名称的块，注意是一个也可以 多个也可以

ludaweb

1. ;选择图块
   
2. (defun c:xk (/ ss n ent blk blks lst->str)
   
3.   (defun lst->str ( lst del / str )
   
4.     (setq str (car lst))
   
5.     (foreach itm (cdr lst) (setq str (strcat str del itm)))
   
6.     str
   
7.   )
   
8.   (princ "\n选择源图块<可多选>:")
   
9.   (if (setq ss (ssget '((0 . "INSERT"))))
   
10.     (progn
    
11.       (setq blks nil)
    
12.       (setq n -1)
    
13.       (repeat (sslength ss)
    
14.         (setq ent (ssname ss (setq n (1+ n))))
    
15.         (setq blk (cdr (assoc 2 (entget ent))))
    
16.         (if (not (member blk blks))
    
17.           (setq blks (cons blk blks))
    
18.         )
    
19.       )
    
20.       (if (and (setq blks (lst->str blks ",")) (setq ss (ssget (list (cons 2 blks)))))
    
21.         (progn
    
22.           (sssetfirst nil ss)
    
23.           (princ (strcat "\n共选中了" (itoa (sslength ss)) "个图块。"))
    
24.         )
    
25.       )
    
26.     )
    
27.   )
    
28.   (princ)
    
29. )
    
30. ;选择图块-全图
    
31. (defun c:xka (/ ss n ent blk blks lst->str)
    
32.   (defun lst->str ( lst del / str )
    
33.     (setq str (car lst))
    
34.     (foreach itm (cdr lst) (setq str (strcat str del itm)))
    
35.     str
    
36.   )
    
37.   (princ "\n选择源图块<可多选>:")
    
38.   (if (setq ss (ssget '((0 . "INSERT"))))
    
39.     (progn
    
40.       (setq blks nil)
    
41.       (setq n -1)
    
42.       (repeat (sslength ss)
    
43.         (setq ent (ssname ss (setq n (1+ n))))
    
44.         (setq blk (cdr (assoc 2 (entget ent))))
    
45.         (if (not (member blk blks))
    
46.           (setq blks (cons blk blks))
    
47.         )
    
48.       )
    
49.       (if (and (setq blks (lst->str blks ",")) (setq ss (ssget "x" (list (cons 2 blks)))))
    
50.         (progn
    
51.           (sssetfirst nil ss)
    
52.           (princ (strcat "\n共选中了" (itoa (sslength ss)) "个图块。"))
    
53.         )
    
54.       )
    
55.     )
    
56.   )
    
57.   (princ)
    
58. )

;选择图块<br /> (defun c:xk (/ ss n ent blk blks lst->str)<br />   (defun lst->str ( lst del / str )<br />     (setq str (car lst))<br />     (foreach itm (cdr lst) (setq str (strcat str del itm)))<br />     str<br />   )<br />   (princ "\n选择源图块<可多选>:")<br />   (if (setq ss (ssget '((0 . "INSERT"))))<br />     (progn<br />       (setq blks nil)<br />       (setq n -1)<br />       (repeat (sslength ss)<br />         (setq ent (ssname ss (setq n (1+ n))))<br />         (setq blk (cdr (assoc 2 (entget ent))))<br />         (if (not (member blk blks))<br />           (setq blks (cons blk blks))<br />         )<br />       )<br />       (if (and (setq blks (lst->str blks ",")) (setq ss (ssget (list (cons 2 blks)))))<br />         (progn<br />           (sssetfirst nil ss)<br />           (princ (strcat "\n共选中了" (itoa (sslength ss)) "个图块。"))<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br /> ;选择图块-全图<br /> (defun c:xka (/ ss n ent blk blks lst->str)<br />   (defun lst->str ( lst del / str )<br />     (setq str (car lst))<br />     (foreach itm (cdr lst) (setq str (strcat str del itm)))<br />     str<br />   )<br />   (princ "\n选择源图块<可多选>:")<br />   (if (setq ss (ssget '((0 . "INSERT"))))<br />     (progn<br />       (setq blks nil)<br />       (setq n -1)<br />       (repeat (sslength ss)<br />         (setq ent (ssname ss (setq n (1+ n))))<br />         (setq blk (cdr (assoc 2 (entget ent))))<br />         (if (not (member blk blks))<br />           (setq blks (cons blk blks))<br />         )<br />       )<br />       (if (and (setq blks (lst->str blks ",")) (setq ss (ssget "x" (list (cons 2 blks)))))<br />         (progn<br />           (sssetfirst nil ss)<br />           (princ (strcat "\n共选中了" (itoa (sslength ss)) "个图块。"))<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

woxin168

如若存在A名称2个块，B名称3个块，如何处理？

woxin168

其实选中也没啥用，看一下，PAN一下就看不见了。我理解，你是想先选需要查找的块，1个或多个，然后在全图中查找。建议程序写找到同名的块后，从原点画一条线到块的插入点，这样PAN命令动一下也能看见。程序应该很好写。

664571221

woxin168 发表于 2023-9-24 09:53
如若存在A名称2个块，B名称3个块，如何处理？

就是同时选中A和B这5个
比如我开始选了一个A后选了一个B，然后框选后全部选中 A和B

664571221

(defun c:tt (/ S)
    ;;选择同名块,不区分动态块形态变化
    (if (setq S (ssget '((0 . "INS*"))))
        (command "SELECTSIMILAR" S "")        
    )   
)谢谢NEWBUG的代码

664571221

664571221 发表于 2023-9-24 14:55
(defun c:tt (/ S)
    ;;选择同名块,不区分动态块形态变化
    (if (setq S (ssget '((0 . "INS*"))))

(defun c:tt (/ e ft i s ss)
    ;;选择同名块
    (vl-load-com)
    (if (and (setq ft '((0 . "INS*")))
                (setq ss (ssget ft))
                (setq i -1)
                (setq s "")
            )
        (progn            
            (while (setq e (ssname ss (setq i (1+ i))))
                (setq e (cdr (assoc 2 (entget e))))
                (if (wcmatch e "`*U*")
                    (setq e (strcat "`" e))
                )
                (setq s (strcat s "," e))
            )
            (sssetfirst nil (ssget "A" (append ft (list (cons 2 (substr s 2))))))
        )        
    )   
)

664571221

664571221 发表于 2023-9-24 14:57
(defun c:tt (/ e ft i s ss)
    ;;选择同名块
    (vl-load-com)

(defun c:tt (/ ft s)
    ;;选择同名块
    (vl-load-com)
    (if (and (setq ft '((0 . "INS*")))
                (ssget ft)
                (setq s "")
            )            
        (progn            
            (vlax-for e (vla-get-ActiveSelectionSet (vla-get-ActiveDocument(vlax-get-acad-object)))
                (setq e (vla-get-name e))
                (if (wcmatch e "`*U*")
                    (setq e (strcat "`" e))
                )
                (setq s (strcat s "," e))
            )
            (sssetfirst nil (ssget "A" (append ft (list (cons 2 (substr s 2))))))
        )        
    )   
)

wzg356

都用选择工具得了，我的帖子有，小菜选择，常青藤选择等都可以，风格不同