获取插入名称以获取乐趣
我的目标是返回带有ssget函数块名的列表的函数：例子：
"block1,block2,xref1,xref2,dynblock1,*A1dynblock1,*A2dynblock1"
有人能验证我的lisp例程吗？
主要功能：
;bit
;0 - all
;1 - without "blocks"
;2 - without dynamic blocks
;4 - without xrefs
;(PZ:GetInsertNames (ssget '((0 . "INSERT"))) (+ 2 4))
(defun PZ:GetInsertNames ( ss bit / sl enl res)
;remove objs from ss that are not insert - just in case
(setq
sl
(vl-remove-if-not
'(lambda (_1)
(eq (cdr (assoc 0 (entget (vlax-vla-object->ename _1)))) "INSERT")
)
(cd:SSX_Convert ss 1)
)
)
;remove blocks
(if (= 1 (logand bit 1))
(setq
sl
(vl-remove-if
'(lambda (_1)
(and
(= (vlax-property-available-p _1 'Path) nil)
(= (vlax-get-property _1 'IsDynamicBlock) :vlax-false)
)
)
sl
)
)
)
;remove dynamic blocks
(if (= 2 (logand bit 2))
(setq
sl
(vl-remove-if
'(lambda (_1)
(= (vla-get-IsDynamicBlock _1) :vlax-true)
)
sl
)
)
)
;remove xrefs
(if (= 4 (logand bit 4))
(setq
sl
(vl-remove-if
'(lambda (_1)
(= (vlax-property-available-p _1 'Path) T)
)
sl
)
)
)
(setq sl (mapcar 'vlax-vla-object->ename sl))
(setq enl (mapcar 'LM:al-effectivename sl))
(if (= 0 (logand bit 2))
(foreach _n sl
(if (= (vla-get-IsDynamicBlock (vlax-ename->vla-object _n)) :vlax-true)
(setq enl(LM:ListUnion (cd:BLK_GetDynBlockNames (LM:al-effectivename _n)) enl))
)
)
)
(setq res (cd:STR_ReParse (LM:Unique enl)","))
res
)
子程式
(defun LM:al-effectivename ( ent / blk rep )
(if (wcmatch (setq blk (cdr (assoc 2 (entget ent)))) "`**")
(if
(and
(setq rep
(cdadr
(assoc -3
(entget
(cdr
(assoc 330
(entget
(tblobjname "block" blk)
)
)
)
'("AcDbBlockRepBTag")
)
)
)
)
(setq rep (handent (cdr (assoc 1005 rep))))
)
(setq blk (cdr (assoc 2 (entget rep))))
)
)
blk
)
; =========================================================================================== ;
; Lista nazw blokow (*U) zaleznych od bloku dynamicznego / ;
; List of the blocks name (*U) which depends on a dynamic block ;
;Name - nazwa bloku / block name ;
; ------------------------------------------------------------------------------------------- ;
; (cd:BLK_GetDynBlockNames "NazwaBloku") ;
; =========================================================================================== ;
(defun cd:BLK_GetDynBlockNames (Name / res n xd)
(setq res (list Name))
(vlax-for % (cd:ACX_Blocks)
(if (wcmatch (setq n (vla-get-name %)) "`*U*")
(if
(setq xd
(cd:XDT_GetXData
(vlax-vla-object->ename %)
"AcDbBlockRepBTag"
)
)
(if
(=
(strcase Name)
(strcase
(cdr
(assoc 2
(entget
(handent
(cdr (assoc 1005 (cdr xd)))
)
)
)
)
)
)
(setq res (cons n res))
)
)
)
)
(reverse res)
)
; =========================================================================================== ;
; Lista odnosnikow zewnetrznych / List of external references ;
; =========================================================================================== ;
(defun cd:BLK_GetXrefs (/ res)
(vlax-for % (cd:ACX_Blocks)
(if (= (vla-get-IsXref %) :vlax-true)
(setq res (cons (vla-get-name %) res))
)
)
res
)
; =========================================================================================== ;
; Czyta dane dodatkowe XDATA / Reads additional data XDATA ;
;Ename - nazwa entycji / entity name ;
;App - nil = dla wszystkich aplikacji / for all applications ;
; STR = dla aplikacji App / for App application ;
; ------------------------------------------------------------------------------------------- ;
; (cd:XDT_GetXData (car (entsel)) "CADPL") ;
; =========================================================================================== ;
(defun cd:XDT_GetXData (Ename App)
(if App
(cadr (assoc -3 (entget Ename (list App))))
(cdr (assoc -3 (entget Ename (list "*"))))
)
)
;;---------------------=={ List Union }==---------------------;;
;; ;;
;;Returns a list expressing the union of two lists ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;l1,l2 - Lists for which to return the union ;;
;;------------------------------------------------------------;;
;;Returns:A list of all distinct items in the two lists ;;
;;------------------------------------------------------------;;
;_$ (LM:ListUnion '(1 2 3 4 5) '(2 4 6 )
;(1 2 3 4 5 6
(defun LM:ListUnion ( l1 l2 / x l )
(setq l1 (append l1 l2))
(while (setq x (car l1)) (setq l (cons x l) l1 (vl-remove x l1)))
(reverse l)
)
; =========================================================================================== ;
; Zmienia PICKSET na liste obiektow / Convert PICKSET to list of objects ;
;Ss - zbior wskazan / selection sets ;
;Mode - typ zwracanych obiektow / type of returned objects ;
; 0 = ENAME, 1 = VLA-OBJECT, 2 = SAFEARRAY ;
; ------------------------------------------------------------------------------------------- ;
; (cd:SSX_Convert (ssget) 1) ;
; =========================================================================================== ;
(defun cd:SSX_Convert (Ss Mode / n res)
(if
(and
(member Mode (list 0 1 2))
(not
(minusp
(setq n
(if Ss (1- (sslength Ss)) -1)
)
)
)
)
(progn
(while (>= n 0)
(setq res
(cons
(if (zerop Mode)
(ssname Ss n)
(vlax-ename->vla-object (ssname Ss n))
)
res
)
n (1- n)
)
)
(if (= Mode 2)
(vlax-safearray-fill
(vlax-make-safearray 9
(cons 0 (1- (length res)))
) res
)
res
)
)
)
)
; =========================================================================================== ;
; Laczy liste lancuchow w lancuch z separatorem / ;
; Combines a list of strings in the string with the separator ;
;Lst - lista lancuchow / list of strings ;
;Sep - separator / separator ;
; ------------------------------------------------------------------------------------------- ;
; (cd:STR_ReParse '("OLE2FRAME" "IMAGE" "HATCH") ",") ;
; =========================================================================================== ;
(defun cd:STR_ReParse (Lst Sep / res)
(setq res (car Lst))
(foreach % (cdr Lst)
(setq res (strcat res Sep %))
)
res
)
;; Unique-Lee Mac
;; Returns a list with duplicate elements removed.
;; (LM:Unique '("A" "B" "B" "B" "C" "C" "D" "E" "E" "E" "E"))
;;=>("A" "B" "C" "D" "E")
(defun LM:Unique ( l / x r )
(while l
(setq x (car l)
l (vl-remove x (cdr l))
r (cons x r)
)
)
(reverse r)
) ??试试这个
(setq lst (list "block1,block2,xref1,xref2,dynblock1,*A1dynblock1,*A2dynblock1"))
(setq ss (ssget '((0 . "INSERT")(cons 2 lst)) ))
在你的帖子之前，我为ssget添加了“逃避通配符”，但为什么你不想尝试lst呢？
我的函数的结果是字符串：
"block1,block2,xref1,xref2,dynblock1,`*A1dynblock1,`*A2dynblock1"
编辑。
我知道为什么在第一篇文章中我写了列表，但我应该写字符串
无论如何，字符串是我函数的结果 你想实现这样的目标吗？
这是我目标的一部分，如果你看看我的子程序，你会发现这个函数
我的目标是具有匿名引用/外部参照插入的简单块/动态块的名称。
页:
[1]