Jim Clayton Posted July 13, 2018 Share Posted July 13, 2018 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 Quote Link to comment Share on other sites More sharing options...
Emmanuel Delay Posted July 16, 2018 Share Posted July 16, 2018 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) Quote Link to comment Share on other sites More sharing options...
Jim Clayton Posted July 16, 2018 Author Share Posted July 16, 2018 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. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.