Ok as promised here is some code I cobbled together. I hope it works cause I did this fast and dirty.
The goal is to redefine dynamic blocks in the current drawing with a dwg file on disk, usually located on your server. Before redefining, the routine saves data from the existing blocks to be redefine: custom parameter values, insertioin point, and attribute values. Then it use vla-insert from disk to redefine the db's in the dwg.
You'll need to change the path to your dblock folder before running. [See the (setq db-path ...) below right after the first defun.] I keep all my DB's in one folder. You will have to modify this code if you use more then one folder.
Anyhow, there isn't a lot of code comments, sorry. And beware that this code was written on the fly, while having to do my real job of making drawings. Did some real world testing, seems to work. Not meant to be the best method or even a good method. If you find a better way, let me know.
(defun c:dbupdate (/ attlst blkname blknames db-path dprops
layer n nobj obj ss sslen
)
;;
(setq db-path "k:\\cfg\\acad\\objects\\blocks\\dbi\\") ;; <-- change this to your path
;;
(if (setq ss (sd:ssGetDblock "*")) ;_ change filter to suit
(progn
(setq n 0
sslen (sslength ss)
)
(repeat sslen
(setq obj (vlax-ename->vla-object (ssname ss n))
dprops (sd:GetDBProps obj)
layer (vla-get-layer obj)
attlst (sd:getatts obj "*")
blkname (sd:GetBlockName obj)
n (1+ n)
)
(if (not (vl-position blkname blknames))
(progn (setq blknames (cons blkname blknames))
(setq blkname (strcat db-path blkname ".dwg"))
)
)
(setq nobj (vla-insertblock
(vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object))
)
(vla-get-insertionpoint obj)
blkname
1
1
1
0
)
)
(vla-put-layer nobj (vla-get-layer obj))
(mapcar '(lambda (a) (sd:putattributeVal nobj (car a) (cdr a)))
(car attlst)
)
(sd:PutDBProps nobj dprops)
(vla-put-insertionpoint nobj (vla-get-insertionpoint obj))
(vla-delete obj)
) ;_ repeat
) ;_ progn
) ;_ if
(princ)
)
Here are the subs I ripped from my library. I hope I didn't miss any:
(defun sd:ssGetDblock (EffectiveName / filter n ssUser rslt)
;;
;; Function prompts the user to select blocks which
;; match the specified EffectiveName argument.
;;
;; Returns a selections set or nil
;;
;; Argument:
;; EffectiveName = name of dblock.
;; Can use wildcards accepted by ssget
;;
;; Example:
;; (setq ss (sd:ssGetDblock "ffc-cab-elev-*"))
;; -> <Selection set: 6f>
;;
(setq EffectiveName
(strcase EffectiveName)
filter (list '(0 . "INSERT")
(cons 2 (strcat EffectiveName ",`*U#*"))
)
n 0
)
(prompt (strcat "\nBlocks with names not matching \""
EffectiveName
"\" will be discarded "
)
)
(if (setq ssUser (ssget ":L" filter))
(progn (setq rslt (ssadd))
(repeat (sslength ssUser)
(if (wcmatch
(strcase
(vla-get-effectivename
(vlax-ename->vla-object (ssname ssUser n))
)
)
EffectiveName
)
(ssadd (ssname ssUser n) rslt)
)
(setq n (1+ n))
)
(princ (strcat "\n"
(itoa (sslength ssUser))
" selected, "
(itoa (- (sslength ssUser) (sslength rslt)))
" discarded, "
(itoa (sslength rslt))
" total"
)
)
)
)
rslt
)
(defun sd:GetBlockName (objent)
;; Returns Name of block given the block ename or vla-object
;; (sd:getblockname (car (entsel)))
(if (= 'ENAME (type objent))
(setq objent (vlax-ename->vla-object objent))
)
(cond ((not (vl-position
(vla-get-objectname objent)
'("AcDbMInsertBlock" "AcDbBlockReference")
)
)
nil
)
((and (vlax-property-available-p objent 'isdynamicblock)
(eq (vla-get-isdynamicblock objent) :vlax-true)
)
(vlax-get-property objent "effectivename")
)
(t (vla-get-name objent))
)
)
(defun sd:getatts
(blkobj tagname / nattobjs cattobjs ListTagstrings GetTagstring)
;;;
;;; A multipurpose attribute extractor toolbox function
;;; By Steve Doman 4/26/06
;;;
;;; Given a block object or ename, and an attribute tag name,
;;; this function returns the value of the first matching tag name.
;;; If no match is found, the function returns nil.
;;;
;;; Example:
;;; (sd:getatts (car (entsel "\nSelect block: ")) "Eq-factor")
;;; -> "SomeValue" or nil
;;;
;;; If the tag argument is "*", this function returns a list
;;; containing two lists as described below:
;;;
;;; The first list contains tagnames and values of all normal attibutes.
;;; If no normal attributes are found then the first list will be nil.
;;;
;;; The second list contains tagnames and values of all constant attributes.
;;; If no constant attriutes are found, then the second list will be nil.
;;;
;;; Example:
;;; (setq rslt (getatts (car (entsel "\nSelect block: ") "*")))
;;; -> '(((ntag1 . "nval1") (ntag2 . "nval2") (ntagNth . "nvalNth"))
;;; ((ctag1 . "cval1") (ctag2 . "cval2") (ctagNth . "cvalNth"))
;;; )
;;;
;;; From the result of the previous example, you can...
;;;
;;; Example: Get a list of only the normal attributes
;;; (setq natts (car rslt))
;;;
;;; Example: Get a list of only the constant attributes
;;; (setq catts (cadr rslt))
;;;
;;; Example: Combine both list into one
;;; (setq both (append (car rslt)(cdr rslt)))
;;;
(defun ListTagstrings (attobjlst)
(mapcar
'(lambda (o) (cons (vla-get-tagstring o) (vla-get-textstring o)))
attobjlst
)
)
;;
(defun GetTagstring (attobjlst tag / string)
(setq tag (strcase tag))
(vl-some
'(lambda (o)
(if (= (strcase (vla-get-tagstring o)) tag)
(setq string (vla-get-textstring o))
)
)
attobjlst
)
string
)
;;
(if (= (type blkobj) 'ename)
(setq blkobj (vlax-ename->vla-object blkobj))
)
(if (and (= (vla-get-objectname blkobj) "AcDbBlockReference")
(= (vla-get-hasattributes blkobj) :vlax-true)
)
(progn (setq nattobjs
(vl-catch-all-apply
'vlax-safearray->list
(list (vlax-variant-value (vla-getattributes blkobj))
)
)
)
(setq cattobjs
(vl-catch-all-apply
'vlax-safearray->list
(list (vlax-variant-value
(vla-getconstantattributes blkobj)
)
)
)
)
(if (vl-catch-all-error-p nattobjs)
(setq nattobjs nil)
)
(if (vl-catch-all-error-p cattobjs)
(setq cattobjs nil)
)
(if (= "*" tagname) ;_ ok, do it
(list (ListTagstrings nattobjs) (ListTagstrings cattobjs))
(cond ((GetTagstring nattobjs tagname))
((GetTagstring cattobjs tagname))
)
)
)
)
)
(defun sd:GetDBProps (objent)
;;;
;;; Returns: a list containing a dynamic blocks custom properties
;;;
;;; Syntax : (GetDBProps ename|object)
;;; where objent is an ename or vla-object of dynamic block
;;;
;;; Example: (GetDBProps (car (entsel "\nSelect dynamic block: ")))
;;;
;;; Based from code by Tony Tanzillo and Herman Mayfarth
;;;
(if (= 'ENAME (type objent))
(setq objent (vlax-ename->vla-object objent))
)
(vl-remove-if
'(lambda (y) (= (car y) "Origin"))
(mapcar '(lambda (x)
(cons (vlax-get-property x "PropertyName")
(vlax-variant-value (vlax-get-property x "Value"))
)
)
(vlax-safearray->list
(vlax-variant-value (vla-getdynamicblockproperties objent))
)
)
)
)
(defun sd:PutDBProps (objent lst / blkprops len propname propvalue n)
;;;
;;; Modifies the custom properties of a dynamic block
;;;
;;; Syntax : (PutDBProps ename|object list)
;;; where objent is an ename or vla-object of dynamic block
;;; and list is a list of dotted pairs of property names and values
;;;
;;; Example1: (PutDBProps
;;; (car (entsel "\nSelect dynamic block: "))
;;; '(("Visibility" . "No Shelves")("Width" . 36.0))
;;; )
;;;
;;; Example2: (PutDBProps
;;; (car (entsel "\nSelect dynamic block: "))
;;; (list
;;; (cons
;;; "Flip state"
;;; (vlax-make-variant 1 vlax-vbinteger)
;;; )
;;; '("Width" . 36.0)
;;; )
;;; )
;;;
;;; Based from code by Tony Tanzillo and Herman Mayfarth
;;;
(if (= 'ENAME (type objent))
(setq objent (vlax-ename->vla-object objent))
)
(setq blkprops
(vlax-safearray->list
(vlax-variant-value
(vla-getdynamicblockproperties objent)
)
)
)
(setq len (length blkprops))
(foreach
prop lst
(setq n 0)
(setq propname (car prop))
(setq propvalue (cdr prop))
(while (< n len)
(if
(= propname (vlax-get-property (nth n blkprops) "PropertyName"))
(progn (vl-catch-all-apply
'vlax-put-property
(list (nth n blkprops) "Value" propvalue)
)
(setq n len)
)
(setq n (1+ n))
)
) ;_while
) ;_foreach
)
{fixed code formating}
