Topic: DBX Testing

[Kerry]

I'ts late, and I'm just about brain dead ..

Can anyone see any hidden < or obvious> traps in this.
It seems to work as intended, but I'd be happier having some fresh eyes look at it.

A bonus for anyone who breaks it < hmmmmm .. beer >

The Test routines just collect Block Names from unopened drawings ...

regards
kwb

Code: [Select]


;;;-------------------------------------------------------------------
;;;
;; Test the Stuff
;;;--------------------------
;;
;;;; IAcadApplication Object
(or kbsg:acadapp (setq kbsg:acadapp (vlax-get-acad-object)))

;;;; IAcadDocument Object
(or kbsg:activedoc (setq kbsg:activedoc (vla-get-activedocument kbsg:acadapp)))

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

(defun c:test ()
  (setq DbxdwgName (getfiled "Select" (getvar "dwgprefix") "dwg" 0))
  ;;
  ;;
  (setq DbxALLBlockList (kbsf:ReturnBlockList DbxdwgName "*"))
  (princ DbxALLBlockList)
  (terpri)
  ;;
  ;;
  (setq DbxBlockList (kbsf:ReturnBlockList DbxdwgName "SDS*"))
  (princ DbxBlockList)
  (terpri)
  ;;
  ;;
  (setq DbxSpecialBlockList (kbsf:ReturnBlockList DbxdwgName "*22*,*SH"))
  (princ DbxSpecialBlockList)
  (terpri)
  (princ)
)

;;;-------------------------------------------------------------------
;;;
;;; Library Routines
;;;
;;;-------------------------------------------------------------------
;;;

(defun kbsf:ReturnBlockList
       (DbxDwgName SearchPattern / dbxdoc BlockList blockMember)
  (if (setq BlockList '()
            dbxdoc    (kbsf:OpenDbxDocument DbxdwgName)
      )
    (progn
      (vlax-for blockMember (vla-get-blocks dbxdoc)
        (setq DbxBlockName (vla-get-name blockMember))
        (if
          (and (= (vla-get-isxref blockMember) :vlax-false)
               (= (vla-get-islayout blockMember) :vlax-false)
               (not (vl-string-position (ascii "*") DbxBlockName))              
               (wcmatch DbxBlockName SearchPattern )
               
          )
           (setq BlockList (append BlockList (list (vla-get-name blockMember))))
        )
      )
      (kbsf:CloseDbxDocument dbxdoc)
    )
  )
  BlockList
)

;;;-------------------------------------------------------------------
;;;
;;; Open a dbxDoc
;;;

(defun kbsf:OpenDbxDocument
       (DbxdwgName / DBXserver dbxopenCatchit dbxDoc)
  (if (/= DbxdwgName (vla-get-fullname kbsg:activedoc))
    (progn
      (cond
        ((= (substr (getvar "ACADVER") 1 5) "15.06")
         ;; 15.06 will be Ac2002, so first check DBX Registration
         ;;
         (cond
           ((vl-registry-read "HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"
            )
           )
           ((not (setq DBXserver (findfile "AxDb15.dll")))
            (alert "Error: Can't locate ObjectDBX Library (AxDb15.dll)")
           )
           (t
            (startapp "regsvr32.exe" (strcat "/s \"" DBXserver "\""))
            (or
              (vl-registry-read
                "HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"
              )
              (alert
                "Error: Failed to register ObjectDBX ActiveX services for AutoCAD2002."
              )
            )
           )
         )
         ;; Then the interface ...
         ;; .. and open the drawing
         (setq dbxDoc         (vla-getinterfaceobject kbsg:acadapp "ObjectDBX.AxDbDocument")
               dbxopenCatchit (vl-catch-all-apply 'vla-open
                                                  (list dbxDoc DbxdwgName)
                              )
         )
        )
        ;; Otherwise AC2004, 2005, 2006
        ;;
        ((vl-position (substr (getvar "ACADVER") 1 4)
                      (list "16.0" "16.1" "16.2")
         )
         (setq dbxDoc         (vla-getinterfaceobject kbsg:acadapp
                                                      "ObjectDBX.AxDbDocument.16"
                              )
               dbxopenCatchit (vl-catch-all-apply 'vla-open
                                                  (list dbxDoc DbxdwgName)
                              )
         )
        )
        ;; Oooopppps
        ;;
        ((t (prompt "\nUnable to determine interface to DBX Drawing")))
      )
      ;; Really Oooopppps
      ;;
      (if (vl-catch-all-error-p dbxopenCatchit)
        (setq dbxDoc nil)
      )
    )
  )
  dbxDoc
)

;;;-------------------------------------------------------------------
;;;
;;; Close dbxDoc
;;;

(defun kbsf:CloseDbxDocument (dbxdoc)
  (if (= (type dbxDoc) 'VLA-OBJECT)
    (progn (vlax-release-object dbxDoc) (setq dbxDoc nil))
  )
)

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

[Kerry]

Oh, [you] may have to change the BlockName string search pattern in the Test routine call to suit your test Drawing ..

No Dent, that's not worth a beer.

[Kerry]

Then this :

Code: [Select]


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

(defun c:test20 ()
  (setq DbxdwgName (getfiled "Select" (getvar "dwgprefix") "dwg" 0))
  ;;
  ;; Bring in One Block
  ;;
  (setq bo (kbsf:ImportBlock DbxdwgName "SDS22SO"))
  ;;
  ;; Bring in the lot ...
  ;;
  (setq DbxALLBlockList (kbsf:ReturnBlockList DbxdwgName "*"))
  (foreach block DbxALLBlockList (kbsf:ImportBlock DbxdwgName block))
  (princ)
)

;;;-------------------------------------------------------------------
;;;
;;; Import a Block from a DBX Document
;;;     Does not Redefine the block, just adds it.
;;; Return: the block object;
;;;

(defun kbsf:ImportBlock
       (DbxdwgName BlockName / dbxDoc DBXBlocks LocalBlocks)
  ;;
  (if (and DbxdwgName (setq dbxDoc (kbsf:OpenDbxDocument DbxdwgName)))
    (progn
      (setq DBXBlocks   (vla-get-blocks dbxDoc)
            LocalBlocks (vla-get-blocks kbsg:activedoc)
      )
      (vla-copyobjects
        dbxDoc
        (vlax-safearray-fill (vlax-make-safearray vlax-vbobject '(0 . 0))
                             (list (vla-item (vla-get-blocks dbxDoc) BlockName))
        )
        LocalBlocks
      )
      (kbsf:closedbxdocument dbxDoc)
    )
  )
  (vla-item LocalBlocks BlockName)
)

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

[SMadsen]

Looks fine to me, Kerry. Looks solid enough but I haven't tried to break it (too early for beer).

[MP]

I'm barely awake and just quickly prerused, but it looks good to me (tho I didn't run it).

All I could see were minor things to nit pick.

For example, statements like:

Code: [Select]

(or kbsg:acadapp (setq kbsg:acadapp (vlax-get-acad-object)))
Work but mask the intent, esp. for noobs looking at your code. Moreover, they'll fail if for some reason the var in question is set to anything non nil but not necessarrilly to the desired target. Would that ever happen? Highly doubtful, but that didn't stop me from commenting (sorry?).

More nit pickage:

Code: [Select]

(defun kbsf:CloseDbxDocument (dbxdoc)
  (if (= (type dbxDoc) 'VLA-OBJECT)
    (progn (vlax-release-object dbxDoc) (setq dbxDoc nil))
  )
)
The (setq dbxDoc nil) bit is kinda superfluous since dbxdoc is an arg and functionionally equiv to a local.

Finally, I'd probably test for newer versions of AutoCAD first.

See, just nit pickage.

Please don't hate me.

[Kerry]

Thanks Guys

MP ; yeah, I picked up the (setq dbxDoc nil) after I posted.

not superfluous, just stupid ..

[JohnK]

Kerry,

I just had a few anal comments. They are NOT a big deal at all, just some tweeks. You code looks good. (I havnet tried it --ran it-- but it looks rock solid.) I prefixed my comments (there were only two minor ones.)

Code: [Select]

;;;-------------------------------------------------------------------
;;;
;; Test the Stuff
;;;--------------------------
;;
;;;; IAcadApplication Object
(or kbsg:acadapp (setq kbsg:acadapp (vlax-get-acad-object)))
;;
;;
;; Se7en: I personaly dont like this statment. (Well...I have a minor
;;        "imporvment" for it that I like to use.)
;;        If the user has a var of this name (Hardly likely but...) your
;;        app could fail on startup.
;;
;;        This is what I try to do.
;;        (For another 'way' see below.)
;;
;; (defun ifnotalready (a e i)
;;  ;; If not already
;;  ;; if the user dosnet have a var of that name then do something.
;;  ;; this is an example as to how I would load up vars on an unknown
;;  ;; enviroment.
;;   (defun variable-p (a)
;;     ;; variable-p
;;     ;; Test to see if item is a variable or not.
;;     ;; Returns - a boole value
;;     (not (null a)) )
;;
;;   (if (variable-p a)
;;     (eval e)  (eval i)) )
;;
;;

;;;; IAcadDocument Object
(or kbsg:activedoc (setq kbsg:activedoc (vla-get-activedocument kbsg:acadapp)))

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

(defun c:test ()
  (setq DbxdwgName (getfiled "Select" (getvar "dwgprefix") "dwg" 0))
  ;;
  ;;
  (setq DbxALLBlockList (kbsf:ReturnBlockList DbxdwgName "*"))
  (princ DbxALLBlockList)
  (terpri)
  ;;
  ;;
  (setq DbxBlockList (kbsf:ReturnBlockList DbxdwgName "SDS*"))
  (princ DbxBlockList)
  (terpri)
  ;;
  ;;
  (setq DbxSpecialBlockList (kbsf:ReturnBlockList DbxdwgName "*22*,*SH"))
  (princ DbxSpecialBlockList)
  (terpri)
  (princ)
)

;;;-------------------------------------------------------------------
;;;
;;; Library Routines
;;;
;;;-------------------------------------------------------------------
;;;

(defun kbsf:ReturnBlockList
       (DbxDwgName SearchPattern / dbxdoc BlockList blockMember)
  (if (setq BlockList '()
            dbxdoc    (kbsf:OpenDbxDocument DbxdwgName)
      )
    (progn
      (vlax-for blockMember (vla-get-blocks dbxdoc)
        (setq DbxBlockName (vla-get-name blockMember))
        (if
          (and (= (vla-get-isxref blockMember) :vlax-false)
               (= (vla-get-islayout blockMember) :vlax-false)
               (not (vl-string-position (ascii "*") DbxBlockName))              
               (wcmatch DbxBlockName SearchPattern )
               
          )
           (setq BlockList (append BlockList (list (vla-get-name blockMember))))
        )
      )
      (kbsf:CloseDbxDocument dbxdoc)
    )
  )
  BlockList
)

;;;-------------------------------------------------------------------
;;;
;;;       Open a dbxDoc
;;;

(defun kbsf:OpenDbxDocument
       (DbxdwgName / DBXserver dbxopenCatchit dbxDoc)
  (if (/= DbxdwgName (vla-get-fullname kbsg:activedoc))
    ;;
    ;;
    ;;
    ;; Se7en: Just picking at technique; I prefer to use 'cond' in this situation.
    ;;          reasons: 1. Readability.
    ;;                   2. adding process later
    ;;                   3. Same as the above:
    ;;                      -i.e. "responding to user that the app failed."
    ;;                             (cond ((and a) 'T) (T "A dosent exist"))
    ;;
    ;;
    ;;
    (progn
      (cond
        ((= (substr (getvar "ACADVER") 1 5) "15.06")
         ;; 15.06 will be Ac2002, so first check DBX Registration
         ;;
         (cond
           ((vl-registry-read "HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"
            )
           )
           ((not (setq DBXserver (findfile "AxDb15.dll")))
            (alert "Error: Can't locate ObjectDBX Library (AxDb15.dll)")
           )
           (t
            (startapp "regsvr32.exe" (strcat "/s \"" DBXserver "\""))
            (or
              (vl-registry-read
                "HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"
              )
              (alert
                "Error: Failed to register ObjectDBX ActiveX services for AutoCAD2002."
              )
            )
           )
         )
         ;; Then the interface ...
         ;; .. and open the drawing
         (setq dbxDoc         (vla-getinterfaceobject kbsg:acadapp "ObjectDBX.AxDbDocument")
               dbxopenCatchit (vl-catch-all-apply 'vla-open
                                                  (list dbxDoc DbxdwgName)
                              )
         )
        )
        ;; Otherwise AC2004, 2005, 2006
        ;;
        ((vl-position (substr (getvar "ACADVER") 1 4)
                      (list "16.0" "16.1" "16.2")
         )
         (setq dbxDoc         (vla-getinterfaceobject kbsg:acadapp
                                                      "ObjectDBX.AxDbDocument.16"
                              )
               dbxopenCatchit (vl-catch-all-apply 'vla-open
                                                  (list dbxDoc DbxdwgName)
                              )
         )
        )
        ;; Oooopppps
        ;;
        ((t (prompt "\nUnable to determine interface to DBX Drawing")))
      )
      ;; Really Oooopppps
      ;;
      (if (vl-catch-all-error-p dbxopenCatchit)
        (setq dbxDoc nil)
      )
    )
  )
  dbxDoc
)

;;;-------------------------------------------------------------------
;;;
;;; Close dbxDoc
;;;

(defun kbsf:CloseDbxDocument (dbxdoc)
  (if (= (type dbxDoc) 'VLA-OBJECT)
    (progn (vlax-release-object dbxDoc) (setq dbxDoc nil))
  )
)

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

[JohnK]

Oh, i just noticed something else. (Because when my browser was re-directed back to the post this line was right at the top of my screen... *lol*)

...(vlax-release-object dbxDoc) (setq dbxDoc nil))

Isnt "dbxdoc" local? Im not sure this is needed.

[JohnK]

*Se7en puts foot in mouth.*

Sorry, just read the other posts in the thread.

[Mark]

I ran it without problems, Map3D 2006.

[Kerry]

Thanks for the comments.
Those particular Function and Variable prefixes are registered with AutoDesk as part of the ADN symbol registration System. I realise that neither that or the unusual particular form that the names have is any guarantee of uniqueness.
I have seen more unusual names overwritten.

The variables as I use them in production code are also protected from overwriting, something not shown here. The code I use only sets these variables once at startup initialization.

Seven, I don't understand the comments you are making in the code.
What could possibly be simpler and cleaner than an OR statement, in line.
 
Re the OpenDbxDocument function
The code logic does not lend itself to all being part of a conditional, in my opinion. In my Production code I use an assertion test statement for testing in this case. If the assertion fails, just skip out completely and advise the user of the failure. This particular statement is a preconditional test, not a procedural test.


That being said, I do appreciate the comments, but was looking more for potential flaws in logic and Gotcha's.

Regards
kwb

[Kerry]

FWIW,
The previous was written to get to this :
Replacing block definitions from an unopened drawing.
This should work with AC2002 to AC2006.

Code: [Select]


;;;-------------------------------------------------------------------
;;;
(defun c:Test26 ()
  (setq DbxdwgName (getfiled "Select" (getvar "dwgprefix") "dwg" 0))
  ;;
  ;;
  (setq DbxALLBlockList (kbsf:ReturnBlockList DbxdwgName "*")
        LocalBlocksList (kbsf:listCollectionMemberNames
                          (vla-get-blocks kbsg:activedoc)
                        )
  )
  ;;
  ;; If the block from the DBX Drawing exists Local, replace it, otherwise Import it
  ;;
  (foreach block DbxALLBlockList
    (if (vl-position block LocalBlocksList)
      (kbsf:ReplaceBlock DbxdwgName block)
      (kbsf:ImportBlock DbxdwgName block)
    )
  )
  (vla-regen kbsg:activedoc acallviewports)
  (princ)
)

;;;-------------------------------------------------------------------
;;;
;;; Return list of all collection member names
;;;
(defun kbsf:listCollectionMemberNames (collection / itemname returnvalue)
  (setq returnvalue '())
  (vlax-for each collection
    (setq itemname    (vla-get-name each)
          returnvalue (cons itemname returnvalue)
    )
  )
  (reverse returnvalue)
)


;;;-------------------------------------------------------------------
;;;
;;; Replace a local Block definition with Block from unopened DBX drawing.
;;;
;; IF blocks are attributed, will need to harvest the Values and re-apply.
;;

(defun kbsf:ReplaceBlock (DbxdwgName    BlockName     /
                          dbxDoc        DBXBlocks     LocalBlocks
                          DbxBlock      LocalBlock    itemObjects
                         )
  (if (and DbxdwgName (setq dbxDoc (kbsf:OpenDbxDocument DbxdwgName)))
    (progn (setq itemObjects '()
                 DBXBlocks   (vla-get-blocks dbxDoc)
                 LocalBlocks (vla-get-blocks kbsg:activedoc)
                 DbxBlock    (vla-item DBXBlocks BlockName)
                 LocalBlock  (vla-item LocalBlocks BlockName)
           )
           ;;
           ;; Stuff to Copy
           ;;
           (vlax-for item DbxBlock (setq itemObjects (cons item itemObjects)))
           ;;
           ;; Delete the individual Objects from the local Block definition
           ;;
           (vlax-for item LocalBlock (vla-delete item))
           ;;
           ;; Shove the Copy Objects into the Local Block Definition
           ;;
           (vlax-invoke dbxDoc 'CopyObjects (reverse itemObjects) LocalBlock)
    )
  )
  (vla-item LocalBlocks BlockName)
)

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

[Keith™]

doesn't DBX operations kill the bitmap preview? I remember reading that, and while I haven't much need for this type of code (yet) I am wondering if users might find it a pain it the arse because of it ...

[Kerry]

Hi Keith

There is no issue with Previews with these operations ... just dragging stuff from, and interrogating the unopened Drawing.

If changes are made to the unopened Drawing the bitmaps can be restored using batch processing.

IMO
While that may sound like a PITA, its less time consuming and less tedious than having to open the drawings individually to make the changes.


added:
This,
(vlax-invoke dbxDoc 'SaveAs DbxDwgName)
Saves the changes to the database as expected, but as you noted the  Bitmap Preview is lost completely.

In the mean time, Jeff has played with DBX a bit, he may chime in with comments from his experience

[Jeff_M]

!CHIME!
While Tony Tanzillo had his utilities available, there was a function he created with ObjectArx that saved/restored the bitmap. However, he has since stopped offering it and I don't know of any quick workaround.

Hmmm, as I was typing this I saw a post by Tony over on the Adesk ng's. While not specifically about this issue, it may be the fix in R2006+.

If you're using 2006, the managed API makes ObjectDBX ActiveX unnecessary, and you can get the information needed via the managed wrappers for ObjectARX.

Of course, I cannot yet test this.....but it sounds promising.