664571221 发表于 2023-9-24 09:27:38

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

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

ludaweb 发表于 2023-9-24 09:27:39

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

woxin168 发表于 2023-9-24 09:53:35

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

woxin168 发表于 2023-9-24 09:57:42

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

664571221 发表于 2023-9-24 10:19:56

woxin168 发表于 2023-9-24 09:53
如若存在A名称2个块，B名称3个块，如何处理？
就是同时选中A和B这5个
比如我开始选了一个A后选了一个B，然后框选后全部选中 A和B

664571221 发表于 2023-9-24 14:55:41

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

664571221 发表于 2023-9-24 14:57:24

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 发表于 2023-9-24 14:59:04

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 发表于 2023-9-25 20:43:46

都用选择工具得了，我的帖子有，小菜选择，常青藤选择等都可以，风格不同
页: [1]
查看完整版本: 各位大神，求一个输入tt选择一个或多个块后，选中图上同名称的块