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)
