区分组块类型

nyistjz

我自己写了一段代码，是想区别不同的图块类型，但是编组和多重插入，无法区域，请高手看一下，如何修改一下会比较好用。
感谢！

nyistjz

家人们，有没有朋友能搞定的，还望能不吝赐教

用这个解除编组命令时，就是可以直接选中编组的，我就想在编程时，应该也是有办法有实现直接选中编组，有没有朋友知道怎么选中编组。

nyistjz

nyistjz 发表于 2023-5-7 11:51
家人们，有没有朋友能搞定的，还望能不吝赐教

用这个解除编组命令时，就是可以直接选中编组的，我就想在 ...

感谢波波大侠的帮忙，分享出来，希望能大家有帮助

;;-------------------------------------------------
(defun c:tt (/ btg c0 c1 c2 c3 c4 c5 e g ges gns gs p s s0 s1 ss tip)
        (defun btg (k s)
                (mapcar 'cdr
                        (vl-remove-if-not '(lambda (x) (equal k (car x))) s)
                )
        )
        (setvar "CMDECHO" 0)
        (if (setq ss (ssget ))
                (progn
                        (setq c0 (sslength ss) c1 0 c2 0 c3 0 c4 0 )
                        (if (and
                                                (setq s0 (ssget "P" '((0 . "INSERT"))))
                                                (setq s1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex s0))))
                                        )
                                (foreach e s1
                                        (setq e (vlax-ename->vla-object e))
                                        (cond
                                                ((= (vla-get-ObjectName e) "AcDbMInsertBlock")
                                                        (setq c1 (1+ c1))
                                                )
                                                ((vlax-property-available-p e 'path)
                                                        (setq c2 (1+ c2))
                                                )
                                                (T (if (= :vlax-true (vla-Get-HasAttributes e))
                                                                 (setq c3 (1+ c3))
                                                                 (setq c4 (1+ c4))
                                                         )                                                       
                                                )                                               
                                        )
                                )
                        )
                        (if (progn
                                          (command "select" ss "R" s0 "")
                                                (setq ss (ssget "P"))
                                                (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
                                        )
                                (progn
                                        (setq g (dictsearch (namedobjdict) "ACAD_GROUP"))
                                        (setq gns (btg 3 g))
                                        (setq ges (btg 350 g))
                                        (setq gs
                                                (mapcar
                                                        '(lambda(a b)                                                                 
                                                                 (cons a (btg 340 (entget b)))
                                                         )
                                                        gns ges
                                                )                                               
                                        )
                                        (setq gs
                                                (vl-remove-if-not
                                                        '(lambda(x)
                                                                 (vl-remove-if-not '(lambda ( a ) (member a ss)) (cdr x))
                                                         )
                                                        gs
                                                )
                                        )
                                        (setq c5 (length gs))
                                )
                        )
                        (if (and
                                                (setq tip
                                                        (strcat
                                                                "选择图元总计  =" (itoa c0)
                                                                "\n【多重块】      =" (itoa c1)
                                                                "\n【外部参照块】  =" (itoa c2)
                                                                "\n【属性块】      =" (itoa c3)
                                                                "\n【其他块】      =" (itoa c4)
                                                                "\n【组】          =" (itoa c5)
                                                        )
                                                )
                                                (setq p (getpoint "\n点取统计文字位置:"))
                                                (entmakex
                                                        (list '(0 . "MTEXT")
                                                                '(100 . "AcDbEntity")
                                                                '(100 . "AcDbMText")
                                                                (cons 7 (getvar "TEXTSTYLE"))
                                                                (cons 1 tip)
                                                                (cons 10 p)
                                                                (cons 40 5000)
                                                                (cons 62 3)
                                                        )
                                                )
                                        )
                                (princ (strcat "\n" tip))
                        )
                )
        )
        (setvar "CMDECHO" 1)
        (princ)
)
;;-------------------------------------------------

zhangkui9070

挺好，感谢分享