Jump to content

Modify ATTOUT Lisp to Assign Specific Path


Jim Clayton

Recommended Posts

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

Link to comment
Share on other sites

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)

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...