区分组块类型
我自己写了一段代码,是想区别不同的图块类型,但是编组和多重插入,无法区域,请高手看一下,如何修改一下会比较好用。
感谢!
本帖最后由 nyistjz 于 2023-5-7 13:17 编辑
家人们,有没有朋友能搞定的,还望能不吝赐教
用这个解除编组命令时,就是可以直接选中编组的,我就想在编程时,应该也是有办法有实现直接选中编组,有没有朋友知道怎么选中编组。
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)
)
;;------------------------------------------------- 挺好,感谢分享:D-:D-
页:
[1]