+ Reply to Thread
Results 1 to 3 of 3
  1. #1
    Junior Member
    Discipline
    Mechanical
    Using
    AutoCAD 2014
    Join Date
    Jun 2018
    Posts
    11

    Default Modify ATTOUT Lisp to Assign Specific Path

    Registered forum members do not see this ad.

    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.
    Attached Files

  2. #2
    Full Member
    Using
    AutoCAD 2014
    Join Date
    Dec 2010
    Posts
    95

    Default

    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.
    )


    Code:
    (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)

  3. #3
    Junior Member
    Discipline
    Mechanical
    Using
    AutoCAD 2014
    Join Date
    Jun 2018
    Posts
    11

    Default

    Registered forum members do not see this ad.

    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.

Similar Threads

  1. Replies: 8
    Last Post: 22nd Jan 2015, 03:34 am
  2. modify attout.lsp to work with mleader?
    By aoinwpb5222 in forum AutoLISP, Visual LISP & DCL
    Replies: 11
    Last Post: 13th Nov 2013, 07:50 pm
  3. Lisp to measure path - modify
    By sadhu in forum AutoLISP, Visual LISP & DCL
    Replies: 0
    Last Post: 26th Sep 2012, 10:43 pm
  4. Modify xref path in Acad LT 2012
    By deano33 in forum AutoCAD Drawing Management & Output
    Replies: 1
    Last Post: 20th Jun 2012, 05:46 pm
  5. Open CAD drawing at specific path
    By MadMax in forum AutoLISP, Visual LISP & DCL
    Replies: 4
    Last Post: 11th May 2007, 11:28 am

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts