nyistjz 发表于 2023-5-3 18:08:22

区分组块类型



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




nyistjz 发表于 2023-5-7 11:51:59

本帖最后由 nyistjz 于 2023-5-7 13:17 编辑

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

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

nyistjz 发表于 2023-6-15 10:54:06

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 发表于 2023-6-16 22:10:37

挺好,感谢分享:D-:D-
页: [1]
查看完整版本: 区分组块类型