First attempt at Object DBX

Because of a bug in the ActiveX API, the "ActiveSpace"
property does not indicate whether the current space is
model or paper space. It only tells you if the Active
Layout is a paper space layout or the model tab.

To find out the current space regardless what kind of
layout is active, use the CVPORT system variable (if it's
1, you're in paper space).

 

Ok. Thanks for pointing that out Tony.

Tim

 

Here is the code that I have come up with. It has a new dcl so I will attach that also (as a txt file). The problem I am having now is that I can't use the attsynce command within my routine because it will get nested to deep, and the way it works (I don't know how) messes something up so that the routine can only be called once per drawing session per block. I tried to use (acet-attsynce <blockname>) but that didn't seem to work either.

Right now I'm stuck trying to figure out a routine that will work the way the command attsynce does. If anyone can point me in the right directions it will be much appreciated.

Tim
ps change the extension of the attached file from txt to dcl.

(defun ImportBlockDia (BlockList / blist diaload ipblist bilist)

(if BlockList
(progn
(setq blist (vl-sort BlockList '(lambda (x y) (< (vla-get-Name x) (vla-get-Name y)))))
(setq diaload (load_dialog "CloseDwg.dcl"))
(if (not (new_dialog "Cdrawings" diaload))
(exit)
)
(start_list "tx2" 3); clear the list
(mapcar '(lambda (x) (add_list (vla-get-Name x))) blist)
(end_list)
(action_tile "accept"
"(progn
(setq ipblist (get_tile \"tx2\"))
(done_dialog 1)
)"
)
(action_tile "cancel"
"(progn
(setq ipblist nil)
(done_dialog 1)
)"
)
(start_dialog)
(if ipblist
(progn
(setq ipblist (read (strcat "(" ipblist ")")))
(foreach item ipblist
(setq bilist (cons (nth item blist) bilist))
)
)
)
)
)
bilist
)

;----------------------------------------------------------------------

(defun RenameOption (String / Option DiaLoad)

(setq DiaLoad (load_dialog "Yes2AllNo.dcl"))
(if (not (new_dialog "DoOptions" DiaLoad))
(exit)
)
(set_tile "OptionMessage" String)
(action_tile "ok" "(done_dialog 1)")
(action_tile "yes" "(done_dialog 2)")
(action_tile "no" "(done_dialog 0)")
(setq Option (start_dialog))
)

;---------------------------------------------------------------------

(defun c:CopyBlocks (/ filename dbxDoc rslt con *blocks cblist blist cnamelist namelist notinsert optans blkname attlist)

(if (setq filename (getfiled "Select file to copy blocks" (getvar "dwgprefix") "dwg" 4))
(progn
(setq rslt (tmw:OpenDBX filename))
(setq cblist (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-ACAD-Object))))
(vlax-for item cblist
(setq cnamelist (cons (vla-get-Name item) cnamelist))
)
(setq *blocks (vla-get-Blocks (car rslt)))
(vlax-for item *blocks
(if
(and
(/= (vla-get-IsXRef item) :vlax-True)
(not (vl-string-search "|" (vla-get-Name item)))
(not (vl-string-search "*" (vla-get-Name item)))
)
(setq con (cons item con))
)
)
(if (setq blist (ImportBlockDia con))
(foreach item blist
(vla-CopyObjects
(car rslt)
(vlax-SafeArray-Fill (vlax-Make-SafeArray vlax-vbObject '(0 . 0)) (list item))
cblist
)
(setq namelist (cons (vla-get-Name item) namelist))
)
)
(foreach item namelist
(if (member item cnamelist)
(setq notinsert (cons item notinsert))
)
)
(while (> (length notinsert) 0)
(setq optans (RenameOption (strcat "Repace current block " (nth 0 notinsert) " definition?")))
(cond
((= optans 0)
(setq notinsert (cdr notinsert))
)
((= optans 1)
(setq blkname (nth 0 notinsert))
(ReplaceBlock-2 (vla-Item cblist blkname) (vla-item *blocks blkname) (car rslt))
(setq attlist (GetAttNValue blkname nil))
; (command "_.attsync" "_n" blkname)
(PutAttValueBack attlist)
(setq notinsert (cdr notinsert))
)
((= optans 2)
(foreach item notinsert
(setq attlist (GetAttNValue item nil))
(ReplaceBlock-2 (vla-Item cblist item) (vla-item *blocks item) (car rslt))
; (command "_.attsync" "_n" item)
(PutAttValueBack attlist)
)
(setq notinsert nil)
)
)
)
(tmw:CloseDBX rslt T)
)
)
(princ)
)

;----------------------------------------------------------

(defun GetAttNValue (BlockName DocBlock / temp1 temp2 cnt1 EndList BlkColl SpaceList)

(if (not DocBlcock)
(setq DocBlock (vla-get-ActiveDocument (vlax-get-ACAD-Object)))
)
(setq BlkColl (vla-get-Blocks DocBlock))
(vlax-for item BlkColl
(if
(or
(vl-string-search "*MODEL_SPACE" (strcase (vla-get-Name item)))
(vl-string-search "*PAPER_SPACE" (strcase (vla-get-Name item)))
)
(setq SpaceList (cons item SpaceList))
)
)
(foreach item SpaceList
(setq cnt1 0)
(while (/= cnt1 (vla-get-Count item))
(setq temp2 (vla-Item item cnt1))
(if
(and
(vlax-property-available-p temp2 'Name)
(= (vla-get-Name temp2) BlockName)
)
(progn
(setq temp1 (cons (vlax-vla-object->ename temp2) temp1))
(foreach item3 (safearray-value (vlax-variant-value (vla-GetAttributes temp2)))
(setq temp1 (cons (vla-get-TextString item3) temp1))
)
(setq EndList (cons (reverse temp1) EndList))
(Setq temp1 nil)
)
)
(setq cnt1 (1+ cnt1))
)
)
Endlist
)

;--------------------------------------------------------

(defun PutAttValueBack (AttList / temp1)

(foreach item AttList
(setq cnt1 1)
(setq temp1 (car item))
(while
(and
(/= (value 0 (entget (setq temp1 (entnext temp1)))) "SEQEND")
(nth cnt1 item)
)
(if (= (value 0 (entget temp1)) "ATTRIB")
(progn
(vla-put-TextString (MakeX temp1) (nth cnt1 item))
(setq cnt1 (1+ cnt1))
)
)
)
)
)

;====================================================================================================

(defun ReplaceBlock-2 (BlockOld BlockNew NewBlockDoc / OldName ActDoc BlkColl test1 temp1 temp2 temp3)

(setq ActDoc (vla-get-ActiveDocument (vlax-get-ACAD-Object)))
(if (not NewBlockDoc)
(setq NewBlockDoc ActDoc)
)
(if
(and
(= (vla-get-ObjectName BlockOld) "AcDbBlockTableRecord")
(= (vla-get-ObjectName BlockNew) "AcDbBlockTableRecord")
)
(progn
(vlax-for item BlockOld
(vlax-invoke-method item 'Delete)
)
(setq cnt1 0)
(while (/= cnt1 (vla-get-Count BlockNew))
(setq temp1 (vla-Item BlockNew cnt1))
(vla-CopyObjects
NewBlockDoc
(vlax-SafeArray-Fill (vlax-Make-SafeArray vlax-vbObject '(0 . 0)) (list temp1))
BlockOld
)
(setq cnt1 (1+ cnt1))
)
)
)
)

 

Hi Tim,

I'm not sure what you mean by "nested too deep" or why (command "attsync" ... ) isn't
working within your program. I haven't tried running your code.

Here's a little thing which I think proves it should work.

;; Change the color of all attribute definitions contained
;; in the block definition of the selected block.
;; Then command attsync to update the color of attribute
;; references contained in all block references.
(defun c:AttColor ( / doc blocks clr ename blkref blkname blkdef )
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(setq blocks (vla-get-blocks doc))
(setq clr (getint "\nEnter attribute color number: "))
(setq ename (car (entsel "\nSelect block with attributes: ")))
(setq blkref (vlax-ename->vla-object ename))
(setq blkname (vlax-get blkref 'Name))
(setq blkdef (vla-item blocks blkname))
(vlax-for x blkdef
(if (equal "AcDbAttributeDefinition" (vlax-get x 'ObjectName))
(vlax-put x 'Color clr)
)
)
(command "_.attsync" "n" blkname)
(princ)
)

BTW, I noticed a typo in your code: (defun GetAttNValue... (if (not DocBlcock) (setq
DocBlock... Maybe harmless, maybe not?

And may I suggest, this looks like self-inflicted pain.

(setq cnt1 0)
(while (/= cnt1 (vla-get-Count BlockNew))
(setq temp1 (vla-Item BlockNew cnt1))
(vla-CopyObjects
NewBlockDoc
(vlax-SafeArray-Fill (vlax-Make-SafeArray vlax-vbObject '(0 . 0)) (list temp1))
BlockOld
)
(setq cnt1 (1+ cnt1))

As I mentioned in a previous message, just make a list of the vla-objects to be
copied. Then use vlax-invoke, rather than vla-copyobjects. No counting, no loop, and
safe arrays not needed.

(vlax-invoke NewBlockDoc 'CopyObjects < list > BlockOld)

If you don't mind me harping... "NewBlockDoc" sucks as a symbol name. It's just
confusing to those of us here trying to understand the code you posted. And no doubt,
you are making things more difficult for yourself in terms of debugging. Check what I
posted above. Are the symbol names ever confusing in terms of what they refer to?

As I said before, if you want folks here to help with complicated code like this, you
must make it easy to understand. Even if it means rewriting the code for
presentation.

Regards
Joe Burke

 

Joe,

The first time you run the command it works, referring to attsync, but when you try and run it again (on the same block) it doesn't work. It makes it error out with this error "; error: Automation Error. Object was erased ", but if you comment out the attsync command it will work again and again. Concerning the "nested to deep", that happens when you copy the blocks and select the "yes to all" button within the new dialog, when you are copping more then four blocks that are already in the current drawing. I have seen in other post that they got around that using (acet-attsync <blockname>), but I tried that and it didn't seem to work for me.

Thanks for catching the typing error, for now it didn't matter, but if I tried to progress the routine to where I'm copying blocks from one drawing to another drawing where both are opened with Object dbx, then there would be a problem.

|> (vlax-invoke NewBlockDoc 'CopyObjects < list > BlockOld)
This looks a lot easeir. I will keep it in mind for next time I have to use 'CopyObjects

|> "NewBlockDoc"
This the pretty clear to me. The name is referring to the document where the new block is. I couldn't think of any other way to name it to make it clear.

Thanks to all for looking at the codes posted and helping me.

I'm still working on a way to rewrite an attsync type routine so that I can get this finished, and working the way I want it to.

Tim