Make Unique Block

Make Unique Block

Anonymous
Not applicable
44,506 Views
27 Replies
Message 1 of 28

Make Unique Block

Anonymous
Not applicable
Hey guys-

Sketchup has a great feature that allows you to right-click on a component (block) and make it unique in the drawing. Its great for taking an an existing block and modifying it for a specific instance.

Does anyone know of an existing routine that will do something similar?

Thanks.
0 Likes
44,507 Views
27 Replies
Replies (27)
Message 2 of 28

Anonymous
Not applicable

One method maybe to wblock the selected block out
with the file name as block name + date appended.

Erase the block from the current
location.

Then Insert the wblock in the place where the block
was.

 

Paul


style="PADDING-RIGHT: 0px; PADDING-LEFT: 5px; MARGIN-LEFT: 5px; BORDER-LEFT: #000000 2px solid; MARGIN-RIGHT: 0px">
Hey
guys- Sketchup has a great feature that allows you to right-click on a
component (block) and make it unique in the drawing. Its great for taking an
an existing block and modifying it for a specific instance. Does anyone know
of an existing routine that will do something similar?
Thanks.
0 Likes
Message 3 of 28

Anonymous
Not applicable
Thats an option. It would need to append a date down to the second to allow multiple instances. Ideally it would rename the block with the same same and simply append a numeric designation on the end to allow for multiples. Ie, CMU-8_1, CMU-8_2.

I was wondering if a lisp was existing. If not I will put my meager lisp skills to the test and post it here in 6-8 months when I finish it. 🙂
Message 4 of 28

Anonymous
Not applicable

Played with it some but ran out of time. This may get you going in the
right direction. Could be much better.

 

(defun rtd (x) (* x (/ 180.0 pi)))
(defun c:INSTANCE (/ ent_data Ent
bname Bpt Xpt Ypt rot)
  (setq usercmd (getvar "cmdecho"))
 
(setq useros (getvar "osmode"))
  (setvar "osmode" 0)
 
(while
    (not
     
(and
 (setq pickpoint (entsel "\nSelect a block to instance:
"))
 (setq ent_data (entget (car pickpoint)))
 (setq obj (assoc
0 ent_data))
 (= (cdr obj) "INSERT")
     
)
    )
  )
  (setvar "cmdecho" 0)
 
(setq bname (cdr (assoc 2 ent_data))
 Bpt   (cdr (assoc
10 ent_data))
 Xpt   (cdr (assoc 41
ent_data))
 Ypt   (cdr (assoc 42
ent_data))
 rot   (rtd (cdr (assoc 50 ent_data)))
 
)
  (setq dstamp (getvar "cdate"))
  (command "._insert" bname
Bpt Xpt Ypt rot)
  (command "explode" "Last" "._block" dstamp Bpt "P"
"")
  (setvar "osmode" useros)
  (command "._insert" dstamp
pause 1 1 0)
  (setvar "cmdecho" usercmd)
)
0 Likes
Message 5 of 28

Anonymous
Not applicable

This will do a little better:

 

(defun rtd (x) (* x (/ 180.0 pi)))
(defun c:INSTANCE (/ ent_data Ent
bname Bpt Xpt Ypt rot)
  (setq usercmd (getvar "cmdecho"))
 
(setq useros (getvar "osmode"))
  (setvar "osmode" 0)
 
(while
    (not
     
(and
 (setq pickpoint (entsel "\nSelect a block to instance:
"))
 (setq ent_data (entget (car pickpoint)))
 (setq obj (assoc
0 ent_data))
 (= (cdr obj) "INSERT")
     
)
    )
  )
  (setvar "cmdecho" 0)
 
(setq bname (cdr (assoc 2 ent_data))
 Bpt   (cdr (assoc
10 ent_data))
 Xpt   (cdr (assoc 41
ent_data))
 Ypt   (cdr (assoc 42
ent_data))
 rot   (rtd (cdr (assoc 50 ent_data)))
 
)
  (setq dstamp (strcat bname "-" (rtos (getvar "cdate") 2
8)))
  (command "._insert" bname Bpt Xpt Ypt rot
   
"explode" "Last"
    "._block" dstamp Bpt "P" "")
 
(setvar "osmode" useros)
  (command "._insert" dstamp pause 1 1
0)
  (setvar "cmdecho" usercmd)
)
0 Likes
Message 6 of 28

stevor
Collaborator
Collaborator
Since he wanted to make that 'right-clicked' selected INSERT unique, you could use your approach to make a block of the selectee, without the explode; and of the new block name, and use the selected INSERT's insert point for the BLOCK ip and the new INSERT's ip.
S
0 Likes
Message 7 of 28

Anonymous
Not applicable
You, my man, are genius.

Thanks much.
0 Likes
Message 8 of 28

Ian_Bryant
Collaborator
Collaborator
Hi,
here is a different approach which seems to work quite well.

It uses the vla-ConverttoStaticBlock method which works
for standard block inserts as well as dynamic block inserts.

{code}
(defun c:rpb ( / ob oname nname index)
(if
(and
(setq ob (car (entsel "\nSelect block: ")))
(= (cdr (assoc 0 (entget ob))) "INSERT")
(not (vlax-property-available-p
(setq ob (vlax-ename->vla-object ob))
'Path
)
)
(snvalid
(setq oname
(vlax-get-property ob 'Effectivename)
)
)
)
(progn
(setq index 1)
(while
(tblsearch "BLOCK"
(setq nname
(strcat oname "_" (itoa index))
)
)
(setq index (1+ index))
)
(vla-ConverttoStaticBlock ob nname)
)
)
(princ)
)
{code}

Regards Ian
Message 9 of 28

Anonymous
Not applicable

Explode the group then re-group.

0 Likes
Message 10 of 28

john.uhden
Mentor
Mentor

I suggest using anonymous block names.  AutoCAD will assign them for you.  And if you delete them, they don't need to be purged.

 

Maybe my attached UBLOCK.lsp will give you some ideas.

John F. Uhden

0 Likes
Message 11 of 28

joselggalan
Advocate
Advocate

try this

 

;;-------------------------- c:MakeUnikeBlk-----------------------------;;
;; José L. García G - 17/04/17                                          ;;
;;                                                                      ;;
;; This command uses the function: LM:CopyBlockDefinition of Lee Mac    ;;
;;----------------------------------------------------------------------;;
(defun c:MakeUnikeBlk ( / ssTmp NameBlk NewNameBlk GetNameUnique )
	 (defun GetNameUnique (str / ret)
	  (while (tblsearch "BLOCK" (setq ret (strcat str "-" (vl-filename-base (vl-filename-mktemp "Copy"))))))
	  ret
	 )
 ;;---------------------- MAIN ----------------------------
 (prompt "\nSelect Insert Block: ")
 (cond
  ((not (and (setq ssTmp (ssget "_:S:E" '((0 . "INSERT"))))
	     (setq InsBlk (ssname ssTmp 0))))
   (prompt "\nNo block selected.")
  )
  (T
   (setq InsBlk (vlax-ename->vla-object InsBlk))
   (setq NameBlk (vlax-get-property
		  InsBlk
		  (if (vlax-property-available-p InsBlk 'EffectiveName)
		   'EffectiveName 'Name)))

   (setq NewNameBlk (GetNameUnique NameBlk))
   ;;(print NameBlk)(princ " - ")(princ NewNameBlk)(princ)
   (cond
    ((LM:CopyBlockDefinition NameBlk NewNameBlk)
     (vla-put-name InsBlk NewNameBlk)
     (prompt (strcat "\nMake Unique Block: [" NewNameBlk "]."))
    )
   )
  )
 )
 (princ)
)
    

	      
                

;; Copy Block Definition  -  Lee Mac
;; Duplicates a block definition, with the copied definition assigned the name provided.
;; blk - [str] name of block definition to be duplicated
;; new - [str] name to be assigned to copied block definition
;; Returns the copied VLA Block Definition Object, else nil
(defun LM:CopyBlockDefinition ( blk new / abc app dbc dbx def doc rtn vrs )
    (setq dbx
        (vl-catch-all-apply 'vla-getinterfaceobject
            (list (setq app (vlax-get-acad-object))
                (if (< (setq vrs (atoi (getvar 'acadver))) 16)
                    "objectdbx.axdbdocument" (strcat "objectdbx.axdbdocument." (itoa vrs))
                )
            )
        )
    )
    (cond
        (   (or (null dbx) (vl-catch-all-error-p dbx))
            (prompt "\nUnable to interface with ObjectDBX.")
        )
        (   (and
                (setq doc (vla-get-activedocument app)
                      abc (vla-get-blocks doc)
                      dbc (vla-get-blocks dbx)
                      def (LM:getitem abc blk)
                )
                (not (LM:getitem abc new))
            )
            (vlax-invoke doc 'copyobjects (list def) dbc)
            (vla-put-name (setq def (LM:getitem dbc  blk)) new)
            (vlax-invoke dbx 'copyobjects (list def) abc)
            (setq rtn (LM:getitem abc new))
        )
    )
    (if (= 'vla-object (type dbx))
        (vlax-release-object dbx)
    )
    rtn
)
 
;; VLA-Collection: Get Item  -  Lee Mac
;; Retrieves the item with index 'idx' if present in the supplied collection
;; col - [vla]     VLA Collection Object
;; idx - [str/int] Index of the item to be retrieved
(defun LM:getitem ( col idx / obj )
    (if (not (vl-catch-all-error-p (setq obj (vl-catch-all-apply 'vla-item (list col idx)))))
        obj
    )
)

(princ)
0 Likes
Message 12 of 28

Kent1Cooper
Consultant
Consultant

There are other routines out there to do this kind of thing, such as this one and my BlockDupNewName.lsp routine attached at the third Comment there.

 

But I do wonder -- if it's going to become a unique Block for a specific instance, without additional insertions of the same one, do you need it to be a Block at all?  Just Explode it and do whatever adjustments you need to the pieces, and leave them as independent drawing entities.

Kent Cooper, AIA
0 Likes
Message 13 of 28

Anonymous
Not applicable

Hi Jason,

 

Thanks and it works well on all blocks expect the dynamic block, it makes the dynamic block "unique" but lose the parameter and action. Anyway we could improve the lisp for dynamic block?

 

Leo

0 Likes
Message 14 of 28

Anonymous
Not applicable

Hi Jose, 

 

Just a feedback the draw order (wipeout  and hatch go up) is changed and seems like doesnt work for the dynamic block. any thanks for your great work.


Leo

0 Likes
Message 15 of 28

Anonymous
Not applicable

I always liked that "unique" function in SketchUp, too.  Have you tried the "Save Block As" command in the block editor?  It's virtually identical, though it does require the extra step of inserting the new block.

0 Likes
Message 16 of 28

joselggalan
Advocate
Advocate

Yes, I have detected it, it is a problem that arises when using objectdbx with blocks. Do not keep the order of the entities. I have problems with this in other programs where I use objectdbx and it has a difficult solution because I use other routines to put shading and wipeout behind but they do not work in some cases because the order of these (if the block contains several) has been modified.

0 Likes
Message 17 of 28

joselggalan
Advocate
Advocate

This code resolves the object ordering error for the duplicate block using wblock instead of objectDBX.

It also assigns the dynamic properties (if any) of the copied block to the duplicate block.

 

regards.

 

;;-------------------------- c:MakeUnikeBlk-----------------------------;;
;; José L. García G - v.3 3/22/18                                       ;;
;;                                                                      ;;
;;----------------------------------------------------------------------;;
(defun c:BlkMakeUnike ( / ssTmp NameBlk NewNameBlk AuxFile NewBlkRef dynProps resApplyDyn ptIns
		          ;|functions|; BMU:GetNameUnique BMU:CopyBlockDefinition
		                        jlgg-GetDynamicProps jlgg-SetDynamicPropValue
		                        jlgg-ActDoc jlgg-UndoStart jlgg-UndoEnd jlgg-GetBlockName
		      )
 
	;;------------------- jlgg-ActDoc ---------------------;;
	(defun jlgg-ActDoc ()
	  (vla-get-activedocument (vlax-get-acad-object))
	)
	;;------------------ jlgg-UndoStart ----------------------;;
	(defun jlgg-UndoStart (doc)
	    (jlgg-UndoEnd doc)
	    (vla-startundomark doc)
	)
	;;------------------ jlgg-UndoEnd ----------------------;;
	(defun jlgg-UndoEnd (doc)
	 (while (= 8 (logand 8 (getvar 'undoctl)))
	  (vla-endundomark doc)
	 )
	)
 
	;;----------------------- jlgg-GetBlockName ------------------------------
	(defun jlgg-GetBlockName (obj)
	 (if (= (vla-get-ObjectName obj) "AcDbBlockReference")
	  (vlax-get-property obj
	   (if (vlax-property-available-p obj 'EffectiveName)
	      'EffectiveName 'Name
	   )
	  )
	 )
	)
 
	;;---------------------------------- jlgg-GetDynamicProps --------------------------------;;
	(defun jlgg-GetDynamicProps (oBlk)
	 (mapcar
	  (function
	   (lambda (DynBlockRefProp)
	    (cons
	     (vla-get-propertyname DynBlockRefProp)
	     (vlax-get DynBlockRefProp 'value)
	    )
	   )
	  )
	  ;;(#<VLA-OBJECT IAcadDynamicBlockReferenceProperty 0000000031a2a4a8> ..)
	  (vlax-invoke oBlk (function getdynamicblockproperties))
	 )
	)


	;;---------------------------------- jlgg-SetDynamicPropValue ----------------------------;;
	(defun jlgg-SetDynamicPropValue (oBlk sProp NewVal / Return MensErr)
	 ;;(vla-get-UnitsType DynBlockRefProp) ;;sin implementar
	 ;;acDynamicBlockReferencePropertyUnitsType
	 ;;;acNoUnits  : 0 
	 ;;;acAngular  : 1 
	 ;;;acDistance : 2 
	 ;;;acArea     : 3 
	 (setq Return
	  (vl-some
	   (function
	    (lambda (DynBlockRefProp / RetVal)
	     (if (= (strcase sProp) (strcase (vla-get-propertyname DynBlockRefProp)))
	      (cond
	       ((= (vla-get-ReadOnly DynBlockRefProp) :vlax-true)
	        (setq MensErr (strcat "The property [" sProp "] is read-only.")
		      RetVal nil)
	       )
	       ((vl-catch-all-error-p
		 (setq ValVariant (vl-catch-all-apply
				   (function vlax-make-variant)
				   (list NewVal (vlax-variant-type (vla-get-value DynBlockRefProp))))))
	        (setq MensErr (strcat "The property [" sProp "] does not support the data type:" (vl-princ-to-string (type NewVal)))
		      RetVal nil)
	       )
	       ((vl-catch-all-error-p
		 (vl-catch-all-apply
		  (function vla-put-value)
		  (list DynBlockRefProp ValVariant)
		 )
	        )
	        (setq MensErr (strcat "Could not assign the value: "
				      (vl-princ-to-string NewVal) " to the property [" sProp "]")
		      RetVal nil)
	       )
	       (T (setq Retval NewVal))
	      );c.cond
	     );c.if
	     (if RetVal RetVal nil)
	    )
	   )
	   ;;(#<VLA-OBJECT IAcadDynamicBlockReferenceProperty 0000000031a2a4a8> ..)
	   (vlax-invoke oBlk (function getdynamicblockproperties))
	  );vl-some
	 );c.setq
	 (if MensErr (print MensErr))
	 Return
	)
 
	;;--------------------- BMU:GetNameUnique -------------------------------------
	(defun BMU:GetNameUnique (str / ret)
	 (while (tblsearch "BLOCK" (setq ret (strcat str "-" (vl-filename-base (vl-filename-mktemp "Copy"))))))
	 ret
	)
 
 	;;----------------------------- BMU:CopyBlockDefinition ---------------------------------;;
	;; Copy Block Definition                                                                 ;;
	;; Duplicates a block definition, with the copied definition assigned the name provided. ;;
	;; NamBlk -    [str] name of block definition to be duplicated                           ;;
	;; NamBlkNew - [str] name to be assigned to copied block definition                      ;;
	;; Returns the copied VLA Block Definition Object, else nil                              ;;
 	;;---------------------------------------------------------------------------------------;;

        ;;Using wblock:
	(defun BMU:CopyBlockDefinition ( NamBlk NamBlkNew / thum expr dir NameBlkTmp BlksDoc rtn)
	 (setq NameBlkTmp  "$BlkTmp$")
	 (setq thum (getvar 'thumbsave))
	 (setq expr (getvar 'expert))
	 (setq dir (getvar 'tempprefix))
	 (setvar "thumbsave" 0)
	 (setvar "expert" 2)
	 (vl-cmdf "_-wblock" (strcat dir NameBlkTmp) NamBlk)
	 (vl-cmdf "_.insert" (strcat NamBlkNew "=" (strcat dir NameBlkTmp)))(vl-cmdf)
	 (setvar 'expert expr)
	 (setvar 'thumbsave thum)
	 (setq BlksDoc (vla-get-blocks (jlgg-ActDoc)))
	 (setq rtn (vla-item BlksDoc NamBlkNew))
	);c.defun
 
 ;;---------------------- MAIN ----------------------------
 (prompt "\nSelect block: ")
 (setvar 'NOMUTT 1)
 (setq SSTmp (vl-catch-all-apply (function ssget) (list "_:S:E" '((0 . "INSERT")))))
 (setvar 'NOMUTT 0)
 (cond
  ((vl-catch-all-error-p SSTmp))
  ((not SSTmp)
   (prompt "\nNo block selected")
  )
  (T
   (setq InsBlk (vlax-ename->vla-object (ssname ssTmp 0))) 
   (setq ptIns (vla-Get-InsertionPoint InsBlk))
   (setq dynProps (jlgg-GetDynamicProps InsBlk))
   (setq NameBlk (jlgg-GetBlockName InsBlk))
   (setq NewNameBlk (BMU:GetNameUnique NameBlk))
   ;;(print NameBlk)(princ " - ")(princ NewNameBlk)(princ)
   (jlgg-UndoStart (jlgg-ActDoc))
   (cond
    ((setq NewBlkRef (BMU:CopyBlockDefinition NameBlk NewNameBlk))
     (vla-put-name InsBlk NewNameBlk)
     (vla-update InsBlk)
     (cond
      (dynProps
       (mapcar
	(function
	 (lambda (pairProp)
	  (setq resApplyDyn
		(vl-catch-all-apply
		 (function jlgg-SetDynamicPropValue)
		 (list InsBlk (car pairProp) (cdr pairProp))
		)
          )
	 )
	)
	dynProps
       );c.mapcar
       (vla-put-InsertionPoint InsBlk ptIns)
      )
     );c.cond
     (prompt (strcat "\nMake Unique Block: [" NewNameBlk "]."))
    )
   );c.cond
   (jlgg-UndoEnd (jlgg-ActDoc))
  )
 );c.cond
 (princ)
)

(princ)
Message 18 of 28

Anonymous
Not applicable

Hi José,

Great code thank you! I have an issue using this as i am creating multiple separate drawings, which eventually all get inserted into a master sheet. This is when i am finding the duplicate block issue. This code makes the blocks in the individual files unique but i still have issues when they are inserted into the master drawing. I was thinking if the new block name could include the current drawing filename it would resolve this issue, but i am not sure how to modify your code to do this. Please could you help?

Thanks

Mark

0 Likes
Message 19 of 28

mahmoudsmonem
Community Visitor
Community Visitor

Just Block the block itself then explode it inside and make your edits

Message 20 of 28

3dwannab
Advocate
Advocate

Great bit of code. Thanks for this.

 

I might not have the know-how to change it to work and I don't want to tamper with your work to get it to work with a selection set of blocks.

 

I'm putting together a new MEP legend and copying existing dynamic blocks to create unique (or very similar) blocks. This would be handy when I have the first block perfectly set up so I can change it to suit.

 

Thanks again!

0 Likes