Hi All
I have the following routine that I am trying to get work. It is the match properties command for dynamic blocks. It is suppose to match the property of the first selected dynamic block. It works fine on all blocks except those that have flip states (my current observation). I get the following message when it fails: "INTERNAL error in FAIL\nmessage lost, reset to top" Error: Automation Error. Invalid input." Any help is greatly appreciated. Thank you.
Manuel
Code:
(defun cm:PutDBProps (objent lst / blkprops len propname propvalue n)
(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)
(cond
((= propname "Flip state")
(vlax-make-variant propvalue vlax-vbinteger)
(setq n len)
)
((= propname (vlax-get-property (nth n blkprops) "PropertyName"))
(vl-catch-all-apply 'vlax-put-property (list (nth n blkprops) "Value" propvalue))
(setq n len)
)
)
(setq n (1+ n))
)
)
)
(defun cm:GetDBProps (objent / x y)
(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 c:matchdb (/ ent bname db-proplst sset ssent cntr ssobj db-flip flipval)
(prompt "\nMatch dynamic block properties: ")
(if (setq ent (car (entsel "\nSelect source block: ")))
(progn
(setq bname (vla-get-EffectiveName (vlax-ename->vla-object ent)))
(setq db-proplst (cm:GetDBProps ent))
; (foreach item db-proplst
; (if (= (car item) "Flip state")(setq db-flip T flipval (cdr item)))
; )
(prompt "\nSelect destination object (s): ")
(if (setq sset (ssget '((0 . "INSERT"))))
(progn
(setq cntr 0)
(while (< cntr (sslength sset))
(setq ssent (ssname sset cntr)
ssobj (vlax-ename->vla-object ssent)
)
(if (= bname (vla-get-EffectiveName ssobj))
(progn
(cm:PutDBProps ssobj db-proplst)
; (if db-flip (cm:setdbval ssobj "Flip state" flipval))
)
(princ "\nSelected block is not identical to source!")
)
(setq cntr (1+ cntr))
)
)
)
)
)
(princ)
)