Insert a "sub"-block into existing block definition

Hi,

I have been struggling the past days trying to accomplish the following:

I have an exisiting block definition (blockname could be: "ParentBlock1") in this block is inserted a another block (blockname could be "ChildBlockOld"). In the definition of ParenBlock1, I want to replace ChildBlokcOld with ChildBlockNew.

I got some experience with good old AutoLisp but I don't think the "classic" functions for entity manipulation can do the job. The VisualLisp (vlax- & vla- stuff) and object apporach is unknown turf. Therefore I searched the web for inspiration and found 2 visual lisp routines, which seems to be made for this purpose (thanks to the guy who posted these originally)

ax:DeleteObjectFromBlock and

ax:AddObjectsToBlock

The "Delete-piece" works fine, and removes the ChildBlockOld from ParentBlock1, but I get all kind of error messages when I try to add the ChildBlockNew.

It is possibly me doing sopmething wrong or missing the obvious.

Are anybody familiar with these 2 routines or similar which will do the job, and can guide me in the right direction.

B.R

carsten

Hi Carsten,

How about something like this?

;;----------------=={ 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 [sTR]                                ;;
;;------------------------------------------------------------;;

(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)
)
   

Hi Lee Mac,

Thanks for your response. I will be on the road for the next couple days, so it will take me some time to explore and understand the attached code if it can be solution to my problem.

Regards

Carsten

Not a problem

Lee Mac,

This just works, many thanks.

I incoporporated your code, it is exactly what I wanted.

I can also see that my own attempts to get there were not even close.

Maybe I could have reached the goal with (command "_BEdit" etc.)

But the VLA- approach seems to be a more solid solution, and has better portability since the BEDIT was only introduced with ACAD 2006.

May be you can help me with a final question? The above problem was last step in a sequence which also included "copying" a block definition, so I have a copy with a new blockname and this is the one I modify (I still need the old block without modification). Currently I do this by:

(command "._Bedit" ABNStack)

(command "._Bsaveas" (strcat ABNStack "BC"))

(command "._BClose") ) )

Is there a more prof "VLA-" thing which does the same?

Thanks & regards

Carsten

This will copy a block with a new name using an ObjectDBX Doc to copy the block def to and from.

http://www.cadtutor.net/forum/showthread.php?t=48840

Oh, btw I updated my code to account for all Views and UCS's:

;;----------------=={ 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 [ENAME]  ;;
;;------------------------------------------------------------;;

(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 [sTR]                                ;;
;;------------------------------------------------------------;;

(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)
)

Also includes a 'Removefromblock' option.

Lee,

how much do you write vs what you've already done from previous LISPS?

Just seeing if my method, of using other lisps to start with, is a bad idea.. I tend to modify more than I write from scratch

I have a library of about 400 subs that I draw from, and when using them I look over them for improvements - the rest is from scratch.

I have a library of about 400 subs that I draw from, and when using them I look over them for improvements - the rest is from scratch.

Nice. I figured you had a bag of tricks laying around. I realize it's a silly question but I always worry if I'm going in the right direction or not. From the looks of things you're very organized. That's something I have to work on.

Nice. I figured you had a bag of tricks laying around. I realize it's a silly question but I always worry if I'm going in the right direction or not. From the looks of things you're very organized.

Thanks - I wouldn't worry about going in the wrong direction, you're only going to learn if you make a few mistakes along the way.

Lee,

Thanks again, I got it all working now exactly as per my intentions... took me a while, but that was more than anything else due to record breaking high temperatures here in DK over the weekend (around 33C) and the final plays of the football championship.

I used your "copyblock" code from the link you sent, instead of the alternative "ObjectDBX Doc - approach" it works fine and seems to be simpler.

Appreciate your responses and code samples.

Carsten

You're quite welcome Carsten