Routine Lisp

[firsrate_caduser]

Hello there! How you guys doing! here I am again asking for help!! and I am very greatful for all those guys that take the time and effort to help others.

 

well here is want a want to do.

 

I wan to create a routing that would invoke a comand, so I will run this routine and invoke let say "ATTEXP2XL" , run it finished and then invoke another command let say "aenext" to go the next drawing. and do that again until go through all the drawings in a project manager.

 

by the way the lisp "attexp2xl" after you run it you have to select objects. How do I modyfi it to select a block name without select it.

 

thank for all you help again!!

[Lee Mac]

With LISP, the function will terminate when going between drawings - so you may need to use a bit of VBA or scripting to accomplish what you require.

[Lee Mac]

Something like this to select blocks with block-name "BLOCKNAME"

 

(setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 "BLOCKNAME")
                         (if (getvar "CTAB")
                             (cons 410 (getvar "CTAB"))
                             (cons 67 (- 1 (getvar "TILEMODE")))))))

[firsrate_caduser]

Lee Mac, thanks for you replay!

 

Can I use that to extract the info from the attributes values from the block? and also how do I use vba in CAD?

 

thanks again!

[Lee Mac]

No, the posted code will only create a selection set of the blocks with that blockname.

 

What are you trying to achieve? I can help with the LISP, but I do not know that much about VBA.

[firsrate_caduser]

What I am trying to do is to use a Lisp called "attexp2xl" which extract block attributes values to excel. When I run it it would ask me to select the objects="blocks with attribuest" and it would extrac the values from the block to excel, and if there is more than one block would extract them too as long as they have the same block name. Now, I have to do that with several drawings. Open a drawing run the lisp and select the blocks and save close and open the next drawing.

 

I am using autocad electric 2009 and using the Project manager which let me have drawings, and a can surf from one to another drawing as long as the drawings are in the project managar. therefore, there is a comand "aenext" that allows me to go to the next drawing and saving the drawing that I am working.

 

I hope this would help you to understand on what I am trying to do.

 

thanks again for all you help!!

 

 

cheers!!

[Lee Mac]

If you post attexp2xl, I could modify it for you to autmatically select blocks - not sure about aenext though, never encountered that kind of thing. sorry

[firsrate_caduser]

Here is the lisp, I got it from this forum. some else post it, and it works great. but if you can modified for want I need that would be even better.

 

thank you!

 

code

attexp2xl.lsp

[Lee Mac]

Give this a shot... untested though...

 

(vl-load-com)
(defun mip-conv-to-str    (dat)
 (if dat
   (vl-princ-to-string dat)
   ""))
(defun get-all-atts  (obj)
 (if (and obj
      (eq :vlax-true (vla-get-HasAttributes obj))
      (vlax-property-available-p obj 'Hasattributes))
   (vl-catch-all-apply
     (function    (lambda    ()
         (mapcar (function (lambda (x)
                     (cons (vla-get-TagString x)
                       (vla-get-TextString x))))
             (append (vlax-invoke obj 'Getattributes)
                 (vlax-invoke obj 'Getconstantattributes)
                 )))))))
;|================== XLS ========================================
* Purpose: Export of the list of data punto_datos in Excell
*             It is exported to a new leaf of the current book.
             If the book is not present, it is created
* Arguments:
             punto_datos - The list of lists of data (LIST) 
                           ((Value1 Value2 ... VlalueN)(Value1 Value2 ... VlalueN)...)
                           Each list of a kind (Value1 Value2... VlalueN) enters the name in
                           a separate line in corresponding columns (Value1-A Value2-B and .ò.ä.)
                 header -  The list (LIST) headings or nil a kind (" Signature A " " Signature B "...)
                           If header nil, is accepted ("X" "Y" "Z")
                Colhide -  The list of alphabetic names of columns to hide or nil - to not hide ("A" "C" "D") - to hide columns A, C, D
                Name_list - The name of a new leaf of the active book or nil - is not present
* Return: nil
* Usage
(xls '((1.1 1.2 1.3 1.4)(2.1 2.2 2.3 2.4)(3.1 3.2 3.3 3.4)) '("Col1" "Col2" "Col3"  "Col4") '("B") "test")   |;
(vl-load-com)
(defun xls  (punto_datos    header       Colhide      Name_list     /        *aplexcel*     *books-colection*
        Currsep        *excell-cells* *new-book*      *sheet#1*     *sheet-collection*           col
        iz_listo        row           cell          cols)
 (defun Letter     (N / Res TMP)
   (setq Res "")
   (while (> N 0)
     (setq TMP    (rem N 26)
       TMP    (if (zerop TMP)
         (setq    N   (1- N)
           TMP 26)
         TMP)
       Res    (strcat (chr (+ 64 TMP)) Res)
       N    (/ N 26)))
   Res)
 (if (null Name_list)
   (setq Name_list ""))
 (setq *AplExcel* (vlax-get-or-create-object "Excel.Application"))
 (if (setq *New-Book* (vlax-get-property *AplExcel* "ActiveWorkbook"))
   (setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
     *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
     *Sheet#1*         (vlax-invoke-method *Sheet-Collection* "Add"))
   (setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
     *New-Book*         (vlax-invoke-method *Books-Colection* "Add")
     *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
     *Sheet#1*         (vlax-get-property *Sheet-Collection* "Item" 1)))
 (setq *excell-cells* (vlax-get-property *Sheet#1* "Cells"))
 (setq    Name_list (if (= Name_list "")
           (vl-filename-base (getvar "DWGNAME"))
           (strcat (vl-filename-base (getvar "DWGNAME")) "&" Name_list))
   col      0
   cols      nil)
 (vlax-for sh *Sheet-Collection* (setq cols (cons (strcase (vlax-get-property sh 'Name)) cols)))
 (setq row Name_list)
 (while (member (strcase row) cols)
   (setq row (strcat Name_list " (" (itoa (setq col (1+ col))) ")")))
 (setq Name_list row)
 (vlax-put-property *Sheet#1* 'Name Name_list)
 (setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators"))
 (vlax-put-property *AplExcel* "UseSystemSeparators" :vlax-false) ;_êå èñïîëüçîâêòü ñèñòåìêûå óñòêêîâêè
 (vlax-put-property *AplExcel* "DecimalSeparator" ".") ;_ðêçäåëèòåëü äðîáêîé è öåëîé ÷êñòè
 (vlax-put-property *AplExcel* "ThousandsSeparator" " ") ;_ðêçäåëèòåëü òûñÿ÷åé
 (vla-put-visible *AplExcel* :vlax-true)
 (setq    row 1
   col 1)
 (if (null header)
   (setq header '("X" "Y" "Z")))
 (repeat (length header)
   (vlax-put-property
     *excell-cells*
     "Item"
     row
     col
     (vl-princ-to-string (nth (1- col) header)))
   (setq col (1+ col)))
 (setq    row 2
   col 1)
 (repeat (length punto_datos)
   (setq iz_listo (car punto_datos))
   (repeat (length iz_listo)
     (vlax-put-property *excell-cells* "Item" row col (vl-princ-to-string (car iz_listo)))
     (setq iz_listo (cdr iz_listo)
       col         (1+ col)))
   (setq punto_datos (cdr punto_datos))
   (setq col 1
     row (1+ row)))
 (setq    col (1+ (length header))
   row (1+ row))
 (setq    cell (vlax-variant-value
          (vlax-invoke-method
        *Sheet#1*
        "Evaluate"
        (strcat "A1:" (letter col) (itoa row))))) ;_ end of setq
 (setq cols (vlax-get-property cell 'Columns))
 (vlax-invoke-method cols 'Autofit)
 (vlax-release-object cols)
 (vlax-release-object cell)
 (foreach item     ColHide
   (if    (numberp item)
     (setq item (letter item)))
   (setq cell (vlax-variant-value
        (vlax-invoke-method
          *Sheet#1*
          "Evaluate"
          (strcat item "1:" item "1"))))
   (setq cols (vlax-get-property cell 'Columns))
   (vlax-put-property cols 'hidden 1)
   (vlax-release-object cols)
   (vlax-release-object cell))
 (vlax-put-property *AplExcel* "UseSystemSeparators" Currsep)
 (mapcar 'vlax-release-object
     (list    *excell-cells* *Sheet#1* *Sheet-Collection* *New-Book* *Books-Colection* *AplExcel*))
 (setq *AplExcel* nil)
 (gc)
 (gc)
 (princ))

(defun C:ATTEXP2XL  (/ blk pat head ss datalist att_list)
 (if (setq ss (ssget "_X" (list (cons 0 "INSERT")(cons 66 1)(if (getvar "CTAB")
         (cons 410 (getvar "CTAB")) (cons 67 (- 1 (getvar "TILEMODE")))))))
   (progn
     (foreach item  (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
   (setq att_list (get-all-atts item))
   (if (null head)
     (setq head (mapcar 'car att_list)))
   (setq datalist (append datalist (list (mapcar 'cdr att_list))))
   )
     (xls datalist head nil nil)
     )
   )
 (princ)
 )

;|=============== Comand AREAS ================================================
Send the Layer, the area, length, color, a hyperlink in corresponding columns Excel.
See also _HYPERLINKOPTIONS |;
(defun c:AREAS    (/ selset *error* retLst lst i UrlDes are)
 (defun *error* (msg) (princ msg) (princ)) ;_ end of defun
 (vl-load-com)
 (if (setq selset (ssget '((0 . "*POLYLINE"))))
   (progn (setq i 1)
      (foreach item  (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset))))
        (if (not (zerop (vla-get-Count (vla-get-Hyperlinks item))))
          (VL-CATCH-ALL-APPLY
        '(lambda () (setq UrlDes (vla-get-URLDescription (vla-item (vla-get-Hyperlinks item) 0)))))
          (setq UrlDes ""))
        (setq lst (list
            (strcat "'" (vla-get-layer item)) ;|Layer"|;
            (rtos (setq are (vla-get-area item)) 2 12) ;|Area|;
            (rtos (vla-get-Length item) 2 12) ;|Length|;
            (vla-get-color item) ;|Color|;
            (if (= UrlDes "")
              ""
              (strcat "'" UrlDes)) ;|Hyperlink|;
            ))
        (setq retLst (append retLst (list lst)))) ;_foreach
      (xls retlst '("Layer" "Area" "Length" "Color" "Hyperlink") nil "from AREAS")))
 (princ))