修改ATTOUT Lisp以分配S
大家好。所以我一直在疯狂地尝试找到一个Lisp例程，它将完全实现我想要做的，我一直在碰壁。我在Excel中开发了一个BOM表生成器。人们可以超快速地分类所有内容，并在短时间内建立完整的BOM表。我需要将数据从Excel传输到AutoCAD。我知道可以使用ATTOUT/ATTIN，但这个过程需要太多步骤。如果我能够只将块句柄导入Excel，我可能会离我想去的地方更近一点。因此，首先，如果有人能解决这整个困境，请提供答案。。。不胜感激。我的下一个思路是使用附加的ATTOUT Lisp并对其进行修改，使其具有指定的路径，并且每次都转到同一个Excel工作表，但只在“句柄”和“块名”上传输。有人知道怎么做吗？谢谢阿托特。LSP 脚本将文件名放入（setq fname…）
除了fname还被用作保存文件指针的变量，这很奇怪。
而不是这样做：
（setq fname（打开fname“W”））
我会的
（setq fp（open fname“W”）；；fp表示文件指针。
无论如何，我将fname设置为“c:\usertemp\Book1.xls”，并注释了fname要求用户选择文件的地方。
检查我的代码的第一行，设置任何适合你的值。
(
-留着吧。xls，而不是a。xlsx公司
-您有两次全部\类型。
)
(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_gettmp_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 byALEJANDRO 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)
非常感谢您抽出时间来做这件事。我一直在到处寻找用Excel数据修改BOM属性的方法，但我一直没有找到答案。。。所以现在我在尝试另一种方法。这让我走得更远。再次感谢你的帮助。
页:
[1]