在exis中插入“子”块
你好过去几天，我一直在努力实现以下目标：
我有一个现有的块定义（blockname可以是：“ParentBlock1”）在这个块中插入另一个块（blockname可以是“ChildBlockOld”）。在ParenBlock1的定义中，我想用ChildBlockNew替换childblockcold。
我有一些使用旧AutoLisp的经验，但我认为用于实体操作的“经典”函数无法完成这项工作。VisualLisp（vlax和vla-stuff）和object-apporach是未知领域。因此，我在网上搜索灵感，找到了2个visual lisp例程，似乎就是为了这个目的而做的（多亏了最初发布这些例程的人）
ax:DeleteObjectFromBlock和
ax:AddObjectsToBlock
“Delete piece”工作正常，并从ParentBlock1中删除ChildBlockOld，但当我尝试添加ChildBlockNew时，会收到各种错误消息。
可能是我做错了什么，或者错过了显而易见的事情。
有谁熟悉这两个或类似的程序，将做的工作，可以引导我在正确的方向。
B、 R
卡斯滕 嗨，卡斯滕，
像这样的怎么样？
;;----------------=={ Add Objects to Block }==----------------;;
;; ;;
;;Adds all objects in the provided SelectionSet to the ;;
;;definition of the specified block. ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, June 2010 ;;
;; ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;block - Entity name of reference insert ;;
;;ss - SelectionSet of objects to add to definition ;;
;;------------------------------------------------------------;;
(defun LM:AddObjectstoBlock ( block ss / ObjLst org doc vector )
;; © Lee Mac 2010
(vl-load-com)
(setq ObjLst (LM:ss->vla ss) org (vlax-3D-point '(0. 0. 0.)))
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq vector
(vlax-3D-point
(mapcar '- (cdr (assoc 10 (entget block)))
(cdr
(assoc 10
(entget
(tblobjname "BLOCK"
(cdr (assoc 2 (entget block)))
)
)
)
)
)
)
)
(mapcar '(lambda ( obj ) (vla-move obj vector org)) ObjLst)
(vla-CopyObjects (vla-get-ActiveDocument (vlax-get-acad-object))
(LM:ObjectVariant ObjLst)
(vla-item (vla-get-Blocks doc)
(LM:GetBlockName (vlax-ename->vla-object block))
)
)
(LM:ApplyFootoSS (lambda ( x ) (entdel x)) ss)
(vla-regen doc acAllViewports)
)
;;------------------=={ Safearray Variant }==-----------------;;
;; ;;
;;Creates a populated Safearray Variant of a specified ;;
;;data type ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, June 2010 ;;
;; ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;datatype - variant type enum (eg vlax-vbDouble) ;;
;;data - list of static type data ;;
;;------------------------------------------------------------;;
;;Returns:VLA Variant Object of type specified ;;
;;------------------------------------------------------------;;
(defun LM:SafearrayVariant ( datatype data )
;; © Lee Mac 2010
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray datatype
(cons 0 (1- (length data)))
)
data
)
)
)
;;-------------------=={ Object Variant }==-------------------;;
;; ;;
;;Creates a populated Object Variant ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, June 2010 ;;
;; ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;lst - list of VLA Objects to populate the Variant. ;;
;;------------------------------------------------------------;;
;;Returns:VLA Object Variant ;;
;;------------------------------------------------------------;;
(defun LM:ObjectVariant ( lst )
;; © Lee Mac 2010
(LM:SafearrayVariant vlax-vbobject lst)
)
;;-----------------=={ SelectionSet -> VLA }==----------------;;
;; ;;
;;Converts a SelectionSet to a list of VLA Objects ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, June 2010 ;;
;; ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;ss - Valid SelectionSet (Pickset) ;;
;;------------------------------------------------------------;;
;;Returns:List of VLA Objects ;;
;;------------------------------------------------------------;;
(defun LM:ss->vla ( ss )
;; © Lee Mac 2010
(if ss
(
(lambda ( i / e l )
(while (setq e (ssname ss (setq i (1+ i))))
(setq l (cons (vlax-ename->vla-object e) l))
)
l
)
-1
)
)
)
;;-------------------=={ Get Block Name }==-------------------;;
;; ;;
;;Retrieves the Block Name as per the Block Definition ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, June 2010 ;;
;; ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;obj - VLA Block Reference Object ;;
;;------------------------------------------------------------;;
;;Returns:Block Name ;;
;;------------------------------------------------------------;;
(defun LM:GetBlockName ( obj )
(vlax-get-property obj
(if (vlax-property-available-p obj 'EffectiveName)
'EffectiveName 'Name
)
)
)
;;------------------=={ Apply Foo to SS }==-------------------;;
;; ;;
;;Applies a function to every entity in a SelectionSet ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, June 2010 ;;
;; ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;foo - a function taking one argument (an entity name) ;;
;;ss- valid SelectionSet (pickset) ;;
;;------------------------------------------------------------;;
;;Returns:Last evaluation of function foo ;;
;;------------------------------------------------------------;;
(defun LM:ApplyFootoSS ( foo ss )
;; © Lee Mac 2010
(
(lambda ( i / e )
(while (setq e (ssname ss (setq i (1+ i)))) (foo e))
)
-1
)
)
;; Test Function.
(defun c:test ( / ss ent )
(if (and (setq ss(ssget "_:L"))
(setq ent (car (entsel "\nSelect Block: ")))
(eq "INSERT" (cdr (assoc 0 (entget ent)))))
(LM:AddObjectstoBlock ent ss)
)
(princ)
)
李，你好，
谢谢你的回复。接下来的几天我会在路上，所以如果能解决我的问题，我需要花一些时间来探索和理解所附的代码。
当做
卡斯滕 没问题 李·麦克，
这很有效，非常感谢。
我加入了你的代码，这正是我想要的。
我还可以看到，我自己的尝试甚至都没有成功。
也许我可以用（命令“_BEdit”等）达到目标
但是，VLA方法似乎是一种更可靠的解决方案，并且具有更好的可移植性，因为BEDIT仅在ACAD 2006中引入。
你能帮我回答最后一个问题吗？上面的问题是序列中的最后一个步骤，其中还包括“复制”块定义，因此我有一个带有新块名的副本，这是我修改的一个（我仍然需要没有修改的旧块）。目前，我通过以下方式完成此操作：
（命令“_Bedit”ABNStack）
（命令“_Bsaveas”（strcat ABNStack“BC”））
（命令“_BClose”））
有没有一个更像“VLA”的东西也能做到这一点？
谢谢和问候
卡斯滕 这将使用ObjectDBX文档复制具有新名称的块，以将块定义复制到其中或从中复制。
http://www.cadtutor.net/forum/showthread.php?t=48840
哦，顺便说一句，我更新了我的代码以考虑所有视图和UCS：
;;----------------=={ Add Objects to Block }==----------------;;
;; ;;
;;Adds all objects in the provided SelectionSet to the ;;
;;definition of the specified block. ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, June 2010 ;;
;; ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;block - Entity name of reference insert ;;
;;ss - SelectionSet of objects to add to definition ;;
;;------------------------------------------------------------;;
(defun LM:AddObjectstoBlock ( block ss / ObjLst doc Mat tMat vector )
;; © Lee Mac 2010
(vl-load-com)
(setq ObjLst (LM:ss->vla ss)
doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq Mat (LM:Geom->Def (vlax-ename->vla-object block)))
(setq vector
(mapcar '-
(cdr
(assoc 10
(tblsearch "BLOCK" (cdr (assoc 2 (entget block))))
)
)
(mxv Mat
(trans (cdr (assoc 10 (entget block)))
(cdr (assoc 210 (entget block))) 0 ; OCS->WCS
)
)
)
)
(setq tMat
(vlax-tmatrix
(append
(mapcar 'append mat (mapcar 'list vector)) '((0. 0. 0. 1.))
)
)
)
(mapcar '(lambda ( obj ) (vla-transformby obj tMat)) ObjLst)
(vla-CopyObjects doc (LM:ObjectVariant ObjLst)
(vla-item (vla-get-Blocks doc)
(LM:GetBlockName (vlax-ename->vla-object block))
)
)
(LM:ApplyFootoSS (lambda ( x ) (entdel x)) ss)
(vla-regen doc acAllViewports)
)
;;-----------------=={ Remove From Block }==------------------;;
;; ;;
;;Removes an Entity from a Block Definition ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, June 2010 ;;
;; ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;ent - Entity name of Object to Delete from Block ;;
;;------------------------------------------------------------;;
(defun LM:RemovefromBlock ( ent )
;; © Lee Mac 2010
(vl-load-com)
(vla-Delete (vlax-ename->vla-object ent))
(vla-regen
(vla-get-ActiveDocument (vlax-get-acad-object)) acAllViewports
)
)
;;------------------=={ Safearray Variant }==-----------------;;
;; ;;
;;Creates a populated Safearray Variant of a specified ;;
;;data type ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, June 2010 ;;
;; ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;datatype - variant type enum (eg vlax-vbDouble) ;;
;;data - list of static type data ;;
;;------------------------------------------------------------;;
;;Returns:VLA Variant Object of type specified ;;
;;------------------------------------------------------------;;
(defun LM:SafearrayVariant ( datatype data )
;; © Lee Mac 2010
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray datatype
(cons 0 (1- (length data)))
)
data
)
)
)
;;-------------------=={ Object Variant }==-------------------;;
;; ;;
;;Creates a populated Object Variant ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, June 2010 ;;
;; ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;lst - list of VLA Objects to populate the Variant. ;;
;;------------------------------------------------------------;;
;;Returns:VLA Object Variant ;;
;;------------------------------------------------------------;;
(defun LM:ObjectVariant ( lst )
;; © Lee Mac 2010
(LM:SafearrayVariant vlax-vbobject lst)
)
;;-----------------=={ SelectionSet -> VLA }==----------------;;
;; ;;
;;Converts a SelectionSet to a list of VLA Objects ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, June 2010 ;;
;; ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;ss - Valid SelectionSet (Pickset) ;;
;;------------------------------------------------------------;;
;;Returns:List of VLA Objects ;;
;;------------------------------------------------------------;;
(defun LM:ss->vla ( ss )
;; © Lee Mac 2010
(if ss
(
(lambda ( i / e l )
(while (setq e (ssname ss (setq i (1+ i))))
(setq l (cons (vlax-ename->vla-object e) l))
)
l
)
-1
)
)
)
;;-------------------=={ Get Block Name }==-------------------;;
;; ;;
;;Retrieves the Block Name as per the Block Definition ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, June 2010 ;;
;; ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;obj - VLA Block Reference Object ;;
;;------------------------------------------------------------;;
;;Returns:Block Name ;;
;;------------------------------------------------------------;;
(defun LM:GetBlockName ( obj )
(vlax-get-property obj
(if (vlax-property-available-p obj 'EffectiveName)
'EffectiveName 'Name
)
)
)
;;------------------=={ Apply Foo to SS }==-------------------;;
;; ;;
;;Applies a function to every entity in a SelectionSet ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, June 2010 ;;
;; ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;foo - a function taking one argument (an entity name) ;;
;;ss- valid SelectionSet (pickset) ;;
;;------------------------------------------------------------;;
;;Returns:Last evaluation of function foo ;;
;;------------------------------------------------------------;;
(defun LM:ApplyFootoSS ( foo ss )
;; © Lee Mac 2010
(
(lambda ( i / e )
(while (setq e (ssname ss (setq i (1+ i)))) (foo e))
)
-1
)
)
;;---------------------=={ Geom->Def }==----------------------;;
;; ;;
;;Returns the Transformation Matrix for transforming Block;;
;;Geometry to the Block Definiton. ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, June 2010 ;;
;; ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;SourceBlock - VLA Block Reference Object ;;
;;------------------------------------------------------------;;
;;Returns:A 3x3 Transformation Matrix ;;
;;------------------------------------------------------------;;
(defun LM:Geom->Def ( SourceBlock / norm ang x y z )
;; © Lee Mac~11.06.10
(vl-load-com)
(setq norm (vlax-get SourceBlock 'Normal)
ang (- (vla-get-rotation SourceBlock)))
(mapcar 'set '(x y z)
(mapcar
'(lambda ( prop alt )
(/ 1.
(vlax-get-property SourceBlock
(if (vlax-property-available-p SourceBlock prop) prop alt)
)
)
)
'(XEffectiveScaleFactor YEffectiveScaleFactor ZEffectiveScaleFactor)
'(XScaleFactor YScaleFactor ZScaleFactor )
)
)
(mxm
(list
(list x 0. 0.)
(list 0. y 0.)
(list 0. 0. z)
)
(mxm
(list
(list (cos ang) (sin (- ang)) 0.)
(list (sin ang) (cos ang) 0.)
(list 0. 0. 1.)
)
(mapcar '(lambda ( e ) (trans e norm 0 t)) ; OCS->WCS
'((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))
)
)
)
)
;; Matrix x Vector~Vladimir Nesterovsky
(defun mxv ( m v )
(mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m))
;; Matrix x Matrix~Vladimir Nesterovsky
(defun mxm ( m q )
(mapcar (function (lambda ( r ) (mxv (trp q) r))) m)
)
;; Matrix Transpose~Doug Wilson
(defun trp ( m ) (apply 'mapcar (cons 'list m)))
;; -- Test Functions --
(defun c:Add ( / *error* doc undo ss ent )
(vl-load-com)
;; © Lee Mac 2010
(defun *error* ( msg )
(and undo (vla-EndUndomark doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(if (and (setq ss(ssget "_:L"))
(setq ent (car (entsel "\nSelect Block: ")))
(eq "INSERT" (cdr (assoc 0 (entget ent)))))
(progn
(setq undo (not (vla-StartUndoMark doc)))
(LM:AddObjectstoBlock ent ss)
(setq undo (vla-EndUndoMark doc))
)
)
(princ)
)
;-------------------------------------------------------------
(defun c:Remove ( / *error* doc undo ss )
(vl-load-com)
;; © Lee Mac 2010
(defun *error* ( msg )
(and undo (vla-EndUndomark doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(if (setq ss (ssget "_:N"))
(progn
(setq undo (not (vla-StartUndoMark doc)))
(mapcar 'LM:RemovefromBlock
(vl-remove-if 'listp
(mapcar 'cadr (ssnamex ss))
)
)
(setq undo (vla-EndUndoMark doc))
)
)
(princ)
)
还包括“Removefromblock”选项。 李，
与以前的LISPS相比，你写了多少？
看看我的方法，使用其他Lisp开始，是不是一个坏主意。。我倾向于修改比我从头开始写更多的内容 我有一个大约400个子库，我从中提取，当使用它们时，我会查看它们的改进-其余的都是从头开始的。
美好的我以为你有一堆诡计。我知道这是一个愚蠢的问题，但我总是担心我是否朝着正确的方向前进。从外表上看，你很有条理。这是我必须努力的事情。
谢谢-我不会担心走错方向，只有在一路上犯了几个错误，你才会学到东西。
页:
[1]
2