Topic: Quick ODBX Question

[Lee Mac]

When iterating through a set of Documents using ObjectDBX, is it best to release the ODBX Document object before opening the next drawing?

[jbuzbee]

I do.

Once you've created an activex reference to an object it's best to release it.

jb

[Lee Mac]

I do.

Once you've created an activex reference to an object it's best to release it.

jb

I've been reading an AU document, which says:

How to close a drawing (2 methods)
o (vlax-release-object odoc) ;be sure to save first.
o (vlax-open odoc “filespecification”)
o You basically have an SDI document interface with each ObjectDBX document.

I would, of course, release the ODBX doc after I have finished with all the drawings - but should I release the ODBX doc after each and every drawing is opened?

Sorry if I have repeated my question - just want to be sure 

[T.Willey]

I don't.  I don't see a reason to.  It is different than a regular document, as in the ODBX document is more like a application to me, than a document, so I only want one instance of the application open at a time.

Edit:  Adding example code to show what I typically do with ODBX

Code: [Select]

(defun MapDbxDocs ( func dwgList / *error* dbxApp oVer RsltList )
   
    (defun *error* (msg)
       
        (if dbxApp
            (vlax-release-object dbxApp)
        )
        (setq dbxApp nil)
        (if msg
            (prompt (strcat "\n Error--> " msg))
        )
    )
    ;--------------------------------------------
    (setq dbxApp
        (if (< (atoi (setq oVer (substr (getvar "acadver") 1 2))) 16)
            (vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")
            (vla-GetInterfaceObject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." oVer))
        )
    )
    (foreach dwg dwgList
        (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-Open (list dbxApp dwg)))
            (prompt (strcat "\n *** Error opening drawing: " dwg))
            (setq RsltList (cons (cons dwg ((eval func) dbxApp)) RsltList))
        )
    )
    (*error* nil)
    RsltList
)

Found here for a example
http://www.theswamp.org/index.php?topic=29933.0

[Lee Mac]

Thanks Tim  

Here is the result of my efforts:

Code: [Select]

(defun c:CheckLayers (/ *error* ObjRelease DirDialog Get_Subs ObjectDBXDocument GetLayers Str-Make

                        DBX DOCLST DWLST FILE FOLDER LAYER_LIST PATH SHELL)
  (vl-load-com)
  ;; Lee Mac  ~  15.01.10
 

  (defun *error* (msg)
    (ObjRelease (list Shell dbx))
    (and ofile (= (type ofile) 'FILE) (close ofile))
   
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** Error: " msg " **")))
    (princ))


  (defun ObjRelease (lst)
    (mapcar
      (function
        (lambda (x)
          (if (and (eq (type x) 'VLA-OBJECT)
                   (not (vlax-object-released-p x)))
            (vl-catch-all-apply
              (function vlax-release-object) (list x))))) lst))
 

  (defun DirDialog (msg dir flag / Shell Fold Path)
    ;; Lee Mac  ~  07.06.09
   
    (setq Shell (vla-getInterfaceObject *acad "Shell.Application")
          Fold  (vlax-invoke-method Shell 'BrowseForFolder
                  (vla-get-HWND *acad) msg flag dir))
    (vlax-release-object Shell)
   
    (if Fold
      (progn
        (setq Path (vlax-get-property
                     (vlax-get-property Fold 'Self) 'Path))
        (vlax-release-object Fold)
       
        (and (= "\\" (substr Path (strlen Path)))
             (setq Path (substr Path 1 (1- (strlen Path)))))))
   
    Path)


  (defun Get_Subs (folder / file) ;; CAB
    (mapcar
      (function
        (lambda (x) (setq file (strcat folder "\\" x))
                    (cons file (apply (function append) (get_subs file)))))
        (cddr (vl-directory-files folder nil -1))))

 
  (defun ObjectDBXDocument (/ acVer)
   
    (vla-GetInterfaceObject *acad
      (if (< (setq acVer (atoi (getvar "ACADVER"))) 16) "ObjectDBX.AxDbDocument"
        (strcat "ObjectDBX.AxDbDocument." (itoa acVer)))))
 

  (defun GetLayerProperties (doc / lst)
    (vlax-for lay (vla-get-Layers doc)
      (setq lst (cons
                  (mapcar
                    (function
                      (lambda (property)
                        (vl-princ-to-string
                          (vlax-get-property lay property))))

                    '(Name Color Linetype LineWeight))

                  lst)))
   
    (vl-sort lst
      (function
        (lambda (a b) (< (car a) (car b))))))

 
  (defun Str-Make  (lst del / Pad str x i)
    (setq i 10)

    (defun Pad  (Str Del Len)
      (while (>= (strlen Str) Len) (setq Len (+ Len 5)))
      (while (< (strlen Str) Len)
        (setq Str (strcat Str Del)))
      Str)

    (apply (function strcat)
           (reverse
             (cons (last lst)
                   (mapcar
                     (function
                       (lambda ($str)
                         (Pad $str del
                              (setq i (abs (- 40 i))))))

                     (cdr (reverse lst)))))))
   

  (setq *acad (cond (*acad) ((vlax-get-acad-object)))
        *doc  (cond (*doc ) ((vla-get-ActiveDocument *acad))))

  (or *def* (setq *def* "Yes"))
 

  (if (and (setq Path (DirDialog "Select Directory" nil 0))
           (vl-file-directory-p Path)
           (setq outfile (getfiled "Output File" "" "txt" 1)))
    (progn

      (initget "Yes No")
      (setq *def* (cond ((getkword
                           (strcat "\nProcess SubDirectories? <" *def* "> : "))) (*def*)))

      (vlax-for doc (vla-get-Documents *acad)
        (setq DocLst
          (cons (cons (strcase (vla-get-FullName doc)) doc) DocLst)))
     

      (foreach dwg (setq dwLst (apply (function append)
                                       (vl-remove 'nil
                                         (mapcar
                                           (function
                                             (lambda (Path)
                                               (mapcar
                                                 (function
                                                   (lambda (File)
                                                     (strcat Path "\\" File)))
                                                 (vl-directory-files Path "*.dwg" 1))))
                                           (append (list Path)
                                                   (apply (function append)
                                                          (if (= "YES" (strcase *def*))
                                                            (Get_Subs Path))))))))

        (setq dbx (cdr (assoc (strcase dwg) DocLst)))       

        (and (not dbx) (setq dbx (ObjectDBXDocument)))
       

        (if (not (vl-catch-all-error-p
                    (vl-catch-all-apply
                      (function vla-open) (list dbx dwg))))

          (setq Layer_List (cons (cons dwg (GetLayerProperties dbx)) Layer_List))
          (setq Layer_List (cons (cons dwg '(("**Error Opening this Drawing **"))) Layer_List))))
               

      (princ (strcat "\n<< " (itoa (length dwLst)) " Drawings Processed >>")))
   
    (princ "*Cancel*"))

  (ObjRelease (list Shell dbx)) (gc) (gc)

  (if (and Layer_List
          (setq ofile (open outfile "w")))
    (progn
     
      (mapcar
        (function
          (lambda (x)
            (write-line (car x) ofile)
            (write-line (Str-Make '("Name" "Colour" "LineType" "LineWeight") (chr 32)) ofile)
            (mapcar
              (function
                (lambda (y)
                  (write-line
                    (Str-Make y (chr 32)) ofile))) (cdr x))
           
            (write-line "\n" ofile)))

        Layer_List)

      (close ofile))

    (princ "\n*Cancel*"))

  (princ))

Will list all Layers in a Folder of Drawings  

[T.Willey]

Hard for me to follow your code.   

One thing I did see though that I would change is that you are stepping through the document collection for every file name.  Just step through it once, making an associated list of drawing path and document, and then just see if the path is within the list.  May save a little bit of time.  No sense stepping though something 50 times when you only need to once.

[Lee Mac]

Hard for me to follow your code.   

I try to make it clear as possible...

One thing I did see though that I would change is that you are stepping through the document collection for every file name.  Just step through it once, making an associated list of drawing path and document, and then just see if the path is within the list.  May save a little bit of time.  No sense stepping though something 50 times when you only need to once.

Ahh good point Tim - will do.

[Lee Mac]

Code updated to reflect Tim's Idea 

[CAB]

Nice one Lee.
Does not report failed DWGs though.

[T.Willey]

I think it's the indentation you use, but that is person preference, and I can understand it, it just takes me longer than I like.  The hardest part is finding the end of you sub's to me, or any long indentation portion.  If I opened it in an editor, I could check that easier, but then I would have to copy/paste it to an editor.   

One thing to watch out on is the name of drawings.  You should make the all one case, upper/lower, and then test the name the same way.

ps. This is a perfect example ( idea of code ) of how my MapDbxDocs routine could be used.

[CAB]

Mod of your subroutine to try out.

Code: [Select]

(defun Str-Make (lst del / Pad str)

  (defun Pad (pStr pDel Len)
    (while (>= (strlen pStr) len)(setq len (+ len 10)))
    (while (< (strlen pStr) Len)
      (setq pStr (strcat pStr pDel))
    )
    pStr
  )

  (mapcar (function (lambda(str$ len#)
      (cond ((null str) (setq str (Pad str$ del len#)))
    ((setq str (strcat Str (Pad str$ del len#)))))))
  lst '(30 10 30 10))
  str
)

[Lee Mac]

Nice one Lee.
Does not report failed DWGs though.

Nice catch CAB - code updated. 

[Lee Mac]

Mod of your subroutine to try out.

Thanks Alan,

Its good for this routine - as the del is a space   

Also, the resultant string will end with the delimiter...  but I like the way that it extends the length of the padding 

[Lee Mac]

Perhaps this instead?

Code: [Select]

(defun Str-Make  (lst del / Pad str x i)
  (setq i 10)

  (defun Pad  (Str Del Len)
    (while (>= (strlen Str) Len) (setq Len (+ Len 5)))
    (while (<  (strlen Str) Len)
      (setq Str (strcat Str Del)))
    Str)

  (apply (function strcat)
         (reverse (cons (last lst)
                        (mapcar
                          (function
                            (lambda ($str) (Pad $str del (setq i (abs (- 40 i))))))

                          (cdr (reverse lst)))))))

CAB, can you see any way of streamlining this a bit more?  I should imagine the "reverse" takes a bit of time...

[CAB]

How about this?

Code: [Select]

(defun Str-Make (lst del / Pad str)

  (defun Pad (pStr pDel Len)
    (or (zerop len)
        (while (>= (strlen pStr) len) (setq len (+ len 10)))
        (while (< (strlen pStr) Len) (setq pStr (strcat pStr pDel)))
    )
    pStr
  )

  (mapcar (function (lambda(str$ len#)
      (cond ((null str) (setq str (Pad str$ del len#)))
    ((setq str (strcat Str (Pad str$ del len#)))))))
  lst '(30 10 30 0))
  str
)

[Lee Mac]

Nice one CAB - thats good, but of course it would only apply to lists of length 4 

[Lee Mac]

Unexpectedly:

Code: [Select]

(BenchMark '((Str-Make-CAB '("1" "2" "3" "4") "+") (Str-Make-Lee '("1" "2" "3" "4") "+")))
Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s):

    (STR-MAKE-LEE (QUOTE ("1" "2" "3" "4...).....1763 / 1.01 <fastest>
    (STR-MAKE-CAB (QUOTE ("1" "2" "3" "4...).....1778 / 1.00 <slowest>
_$ (BenchMark '((Str-Make-CAB '("1" "2" "3" "4") "+") (Str-Make-Lee '("1" "2" "3" "4") "+")))
Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s):

    (STR-MAKE-LEE (QUOTE ("1" "2" "3" "4...).....1763 / 1.03 <fastest>
    (STR-MAKE-CAB (QUOTE ("1" "2" "3" "4...).....1810 / 1.00 <slowest>


[CAB]

Yes, unexpected.
As for the number of string items, to make it universal i would think you would also pass the length list with it.

Code: [Select]

(Str-Make-CAB '("1" "2" "3" "4") '(30 10 30 0) "+")

[CAB]

How does this version time out?

Code: [Select]

(defun Str-Make (lst del / Pad str)

  (defun Pad (pStr pDel Len)
    (or (zerop len)
        (while (>= (strlen pStr) len) (setq len (+ len 10)))
        (while (< (strlen pStr) Len) (setq pStr (strcat pStr pDel)))
    )
    pStr
  )
  (setq str "")
  (mapcar (function (lambda(str$ len#)
      (setq str (strcat Str (Pad str$ del len#)))))
  lst '(30 10 30 0))
  str
)

[Lee Mac]

Not too much in it:

Code: [Select]

(BenchMark '((Str-Make-Lee '("1" "2" "3" "4") "+") (Str-Make-CAB1 '("1" "2" "3" "4") "+") (Str-Make-CAB2 '("1" "2" "3" "4") "+")))
Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s):

    (STR-MAKE-CAB2 (QUOTE ("1" "2" "3" "...).....1810 / 1.01 <fastest>
    (STR-MAKE-LEE (QUOTE ("1" "2" "3" "4...).....1825 / 1.00
    (STR-MAKE-CAB1 (QUOTE ("1" "2" "3" "...).....1825 / 1.00 <slowest>
_$ (BenchMark '((Str-Make-Lee '("1" "2" "3" "4") "+") (Str-Make-CAB1 '("1" "2" "3" "4") "+") (Str-Make-CAB2 '("1" "2" "3" "4") "+")))
Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s):

    (STR-MAKE-LEE (QUOTE ("1" "2" "3" "4...).....1779 / 1.03 <fastest>
    (STR-MAKE-CAB1 (QUOTE ("1" "2" "3" "...).....1794 / 1.02
    (STR-MAKE-CAB2 (QUOTE ("1" "2" "3" "...).....1825 / 1.00 <slowest>
_$ (BenchMark '((Str-Make-Lee '("1" "2" "3" "4") "+") (Str-Make-CAB1 '("1" "2" "3" "4") "+") (Str-Make-CAB2 '("1" "2" "3" "4") "+")))
Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s):

    (STR-MAKE-LEE (QUOTE ("1" "2" "3" "4...).....1794 / 1.03 <fastest>
    (STR-MAKE-CAB2 (QUOTE ("1" "2" "3" "...).....1826 / 1.01
    (STR-MAKE-CAB1 (QUOTE ("1" "2" "3" "...).....1841 / 1.00 <slowest>


[CAB]

How many milliseconds does it take to blink?

[Lee Mac]

In any case, I have updated the code in my previous post 

[CAB]

BTW Lee that is clever method to get the 30 10 30. 

[VovKa]

this will speed up things a bit

Code: [Select]

(defun Pad-VovKa (String Char NewLen / PadString)
  (if (> (setq NewLen (- NewLen (strlen String))) 0)
    (strcat String
    (progn (setq PadString (if (zerop (rem NewLen 2))
     ""
     Char
   )
Char    (strcat Char Char)
   )
   (repeat (/ NewLen 2) (setq PadString (strcat PadString Char)))
   PadString
    )
    )
    String
  )
)

[Lee Mac]

BTW Lee that is clever method to get the 30 10 30. 

Thanks Alan 

[Lee Mac]

this will speed up things a bit

Nice idea VovKa!  Halving the amount of operations 

[ElpanovEvgeniy]

My variant:

Code: [Select]

(defun Str-Make-ee (lst del len)
 (repeat 6 (setq del (strcat del del)))
 (apply (function strcat)
        (mapcar (function (lambda (a b / s)
                           (if (< (setq s (strlen a)) b)
                            (strcat a (substr del 1 (- b s)))
                            a
                           ) ;_  if
                          ) ;_  lambda
                ) ;_  function
                lst
                len
        ) ;_  mapcar
 ) ;_  apply
)test:

Code: [Select]

(setq lst '("1" "2" "3" "4") del "+" len '(30 10 30 0))
(BenchMark '((Str-Make-CAB2 lst del)
             (Str-Make-CAB1 lst del)
             (Str-Make-Lee lst del)
             (Str-Make-ee lst del len)
            )
) ;_  BenchMark
Benchmarking .................Elapsed milliseconds / relative speed for 16384 iteration(s):

    (STR-MAKE-EE LST DEL LEN).....1953 / 2.66 <fastest>
    (STR-MAKE-CAB2 LST DEL).......5047 / 1.03
    (STR-MAKE-CAB1 LST DEL).......5047 / 1.03
    (STR-MAKE-LEE LST DEL)........5203 / 1 <slowest>



[Lee Mac]

Nice variant Evgeniy!

I wouldn't have immediately thought to create the "Padding string" first.. of course it would only work for padding < 2^6 in length, but I'm sure that's sufficient 

Lee

[VovKa]

i think this should be sufficient

Code: [Select]

(repeat (1+ (fix (/ (log (apply 'max Len)) (log 2))))
    (setq del (strcat del del))
  )

[ElpanovEvgeniy]

Nice variant Evgeniy!

I wouldn't have immediately thought to create the "Padding string" first.. of course it would only work for padding < 2^6 in length, but I'm sure that's sufficient 

Lee

Hi Lee, if you know in advance a symbol for addition easier not to create and write down it in the program:
"++++++++++++++++++++++++++++++++++++++++"

[Lee Mac]

Nice variant Evgeniy!

I wouldn't have immediately thought to create the "Padding string" first.. of course it would only work for padding < 2^6 in length, but I'm sure that's sufficient 

Lee

Hi Lee, if you know in advance a symbol for addition easier not to create and write down it in the program:
"++++++++++++++++++++++++++++++++++++++++"

Haha, well of course, as you know it could be any symbol 

[Lee Mac]

i think this should be sufficient

Code: [Select]

(repeat (1+ (fix (/ (log (apply 'max Len)) (log 2))))
    (setq del (strcat del del))
  )

Someone knows their maths