Jump to content
Jim Clayton

Modify ATTOUT Lisp to Assign Specific Path

Recommended Posts

Jim Clayton

Hey everyone. So I've been trying like crazy to find a Lisp routine that will do exactly what I want to do, and I keep hitting walls. I developed a BOM Builder in Excel. People can sort through everything super quick and build a full BOM in no time. I need to transfer that data from Excel to AutoCAD. I know it's possible to do with ATTOUT/ATTIN, but the process takes too many steps. If I were able to import just the block handles into Excel, I might be a little bit closer to where I want to go. So, first and foremost, IF ANYONE HAS A SOLUTION to this whole dilemma, please offer that up...it would be greatly appreciated. My next train of thought is to take the attached ATTOUT Lisp and modify it, so that it has an assigned path and goes to the same Excel sheet every time, but ONLY transfers over the "Handle" and "Block Name". Anyone know how to go about doing this? Thanks.

ATTOUT.LSP

Share this post


Link to post
Share on other sites
Emmanuel Delay

The script puts the filename in (setq fname ...)

 

Except fname also gets used as the variable that holds the file pointer, which is pretty weird.

Instead of doing this:

 

(setq fname (open fname "W"))

 

I would do

(setq fp (open fname "W")) ;; fp for file pointer.

 

Anyway, I set fname to "c:\usertemp\Book1.xls", and I commented out where fname asks for user selected file.

Check the first line of my code, set whatever value suits you.

(

- Keep it a .xls, not a .xlsx

- you have the type all \ twice.

)

 

 

(setq my_filename "C:\\UserTemp\\Book1.xls")


;;  Groups elements in sublist by criteria

(defun subtrack (test lst)
(apply 'append (mapcar '(lambda (x)
(if (eq (car x) test)(list x))) lst)))

;;  Counts equivalent subs in list

(defun countsub    (lst sub)
 (cond    ((null lst) 0)
   ((and (equal (caar lst) (car sub) 0.00001)
         (equal (cadar lst) (cadr sub) 0.00001)
    )
    (1+ (countsub (cdr lst) sub))
   )
   (T (countsub (cdr lst) sub))
 )
)
;;  Get info from block include from constant attributes in following form:
;; (("TAG1" . "VALUE1") ("TAG2" . "VALUE2") ...("*CONSTANT*: TAGN" . "VALUEN"))

 (defun get-all-atts (obj / atts att_list const_atts const_list ent)
   (and
    (if (and obj 
         (vlax-property-available-p obj 'Hasattributes)
         (eq :vlax-true (vla-get-hasattributes obj))
        )
      (progn
        (setq atts (vlax-invoke obj 'Getattributes))
        (foreach att atts
          (setq att_list
             (cons (cons (vla-get-tagstring att)
                 (vla-get-textstring att)
               )
               att_list
             )
          )
        )
      )
    )
   )
   (cond ((vlax-method-applicable-p obj 'Getconstantattributes)
      (setq const_atts (vlax-invoke obj 'Getconstantattributes))
      (foreach att    const_atts
        (setq const_list
           (cons (cons    (vla-get-tagstring att)
               (vla-get-textstring att)
             )
             const_list
           )
        )
      )
      (setq att_list (reverse (append const_list att_list)))
     )
     (T (reverse att_list))
   )
 )

;;            Main part            ;;
 (defun C:ATOUT (/     acsp      adoc       aexc        awb         axss
       bname     cll      colm       com_data csht     data
       exc_data fname      header_list        info     nwb
       osm     row      sht       ss        str1     str2
       subtot     tmp_data tmp_get  tmp_snip tot
          )

   (vl-load-com)
   (setq adoc (vla-get-activedocument
        (vlax-get-acad-object)
          )
     acsp (vla-get-modelspace adoc)
   )
   (setq osm (getvar "osmode"))
   (setvar "osmode" 0)
   (setvar "cmdecho" 0)
   (vla-endundomark adoc)
   (vla-startundomark adoc)

   (vl-cmdf "zoom" "a")
   (vl-cmdf "zoom" ".85x")
   ;;    variations of the selection
   ;;  All blocks :
       (setq ss (ssget "_X" (list (cons 0 "INSERT")(cons 66 1))))
   ;;    Selected on screen:
;;;(setq ss (ssget '((0 . "INSERT"))))
   ;; All blocks by name:
;;;    (setq bname (getstring "\n    ***    Block name:\n"))
;;;    (setq ss (ssget "_X" (list (cons 0 "INSERT")(cons 66 1) (cons 2 bname))))
   (setq axss (vla-get-activeselectionset adoc))
   (setq com_data nil)                  ;for debug only

   (vlax-for a    axss
     (setq tmp_get (get-all-atts a))
     (setq tmp_data (append (list (vla-get-name a)(vla-get-handle a)) tmp_get))
     (setq com_data (cons tmp_data com_data))
     (setq tmp_data nil)
   )                          ;ok
   (setq tot (length com_data))
   (setq exc_data nil)                  ;for debug only
   (while com_data
     (setq tmp_snip
        (subtrack (caar com_data) com_data)
     )
     (setq str1 (strcat "Subtotal blocks "
            "\"" (caar com_data) "\""
                        ": "
        )
       str2
        (itoa (length tmp_snip))
     )
     (setq exc_data (append exc_data
                (list (append tmp_snip (list (list str2 str1))))
            )
       com_data (vl-remove-if
              (function not)
              (mapcar (function (lambda (x)
                      (if (not (member x tmp_snip))
                        x
                      )
                    )
                  )
                  com_data
              )
            )
       tmp_snip nil
     )
   )
   (setq exc_data
          (mapcar (function (lambda (x)
              (mapcar (function (lambda (y)                
                  (append (list (cadr y)(car y))(cddr y))))
                      x
                      )
                              )
                            )
                  exc_data)
                  )
   ;;        Eof calc part        ;;

   ;;    ***    Excel part    ***    ;;
   ;;(setq fn (vl-filename-base (getvar "dwgname")))
   ;;(setq fname (strcat (getvar "dwgprefix") fn ".xls"))
   ;;(setq fname (open fname "W"))
   ;;(close fname)

   (setq fn (vl-filename-base (getvar "dwgname")))
   (setq fname my_filename)    ;; open in read-write.  
   ;;(setq fname (open fname "W"))
   ;;(close fname)


   (princ "*")
   (princ fname)
   (setq fname (findfile fname))
   ;;; Excel part written by  ALEJANDRO LEGUIZAMON -  http://arquingen.tripod.com.co  
   (princ "*")
   (setq aexc (vlax-get-or-create-object "Excel.Application")
     awb  (vlax-get-property aexc "Workbooks")
     nwb  (vlax-invoke-method awb "Open" fname)
     sht  (vlax-get-property nwb "Sheets")
     csht (vlax-get-property sht "Item" 1)
     cll  (vlax-get-property csht "Cells")
   )
   (vlax-put-property csht 'Name "AttOut-AttIn")
   (vla-put-visible aexc :vlax-true)
   (setq row 1
     colm 1
   )
   (setq header_list
          '("HANDLE"
            "BLOCK NAME"
            "TAG1"
            "TAG2"
            "TAG3"
            "TAG4"
            "TAG5"
            "TAG6"
            "TAG7"
            "TAG8"
            "TAG9"
            "TAG10"
           )
   ) ;_ end of setq
   (repeat (length header_list)
     (vlax-put-property
   cll
   "Item"
   row
   colm
   (vl-princ-to-string (car header_list))
     )
     (setq colm (1+ colm)
       header_list
        (cdr header_list)
     )
   )
   (setq row 2
     colm 1
   )
   (repeat (length exc_data)
     (setq data   (reverse (cdr (reverse (car exc_data))))
       subtot (last (car exc_data))
     )
     (repeat (length data)
   (setq info (car data))
   (repeat    (length info)
     (vlax-put-property
       cll
       "Item"
       row
       colm
           (if (< colm 3)
       (vl-princ-to-string (car info))
           (vl-princ-to-string (cdar info)))
     )
     (setq colm (1+ colm))
     (setq info (cdr info))
   )
       (setq data (cdr data))
   (setq row  (1+ row)
         colm 1
   )
     )

     (vlax-put-property
   cll
   "Item"
   row
   colm
   (vl-princ-to-string (car subtot))
     )
     (setq colm (1+ colm))
     (vlax-put-property
   cll
   "Item"
   row
   colm
   (vl-princ-to-string (cadr subtot))
     )

     (setq exc_data (cdr exc_data))
     (setq row     (1+ row)
       colm 1
     )
   )

   (setq row  (1+ row)
     colm 1
   )
   (vlax-put-property
     cll
     "Item"
     row
     colm
     (vl-princ-to-string "TOTAL BLOCKS:")
   )
   (setq colm (1+ colm))
   (vlax-put-property
     cll
     "Item"
     row
     colm
     (vl-princ-to-string tot)
   )
  (setq fcol (vlax-get-property csht "Range" "A:Z"))
  (vlax-put-property fcol "NumberFormat" "@")
;;;        Columns("A:A").Select
;;;    Range("A394").Activate
;;;    Selection.NumberFormat = "@"
   (vlax-invoke (vlax-get-property csht "Columns") "AutoFit")
   (vlax-release-object cll)
   (vlax-release-object fcol)
   (vlax-release-object csht)
   (vlax-release-object sht)
   (vlax-release-object nwb)
   (vlax-release-object awb)
   (vlax-release-object aexc)
   (setq aexc nil)
   (setvar "osmode" osm)
   (setvar "cmdecho" 1)
   (vla-clear axss)
   (vlax-release-object axss)
   (vla-regen adoc acactiveviewport)
   (vla-endundomark adoc)
   (gc)
   (gc)
   ;; (alert "Save Excel manually")
   (princ "\nSave Excel manually: \n")
   (princ)
   )
(princ "\n\t\t***\tStart command with ATOUT...\t***")
(princ)

Share this post


Link to post
Share on other sites
Jim Clayton

Greatly appreciated you taking the time with this. Been searching everywhere for a means to modify BOM attributes with Excel data, but I keep coming up short...so now I'm trying an alternate approach. This gets me alot further along. Thanks again for your help.

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×