将块属性提取到（&A）
我已经修改了这个站点中的以下代码。http://www.cadtutor.co.uk/forum/showthread.php?t=30175
以下内容：
;Global ATTribute EXtractor
;
; by Miklos Fuccaromfuccaro@hotmail.com
;-------------------------November 2004 -------
;revised by SteveoMay 2009
(defun gattex()
(setq ss (ssget "X" '((0 . "INSERT") (66 . 1))))
(if (not ss) (quit))
(setq file (open "c:\\DWG\\RAKE.CSV" "a") i -1)
(write-line (strcat (getvar "DWGPREFIX") (getvar "DWGNAME")
" -found " (itoa (sslength ss))
" block(s) with attributes") file)
(repeat (sslength ss)
(setq l (entget (setq e (ssname ss (setq i (1+ i))))))
(write-line (strcat "block name:" "," (cdr (assoc 2 l))) file)
(while (/= (cdr (assoc 0 l)) "SEQEND")
(if (= (cdr (assoc 0 l)) "ATTRIB")
(write-line (strcat ",," (cdr (assoc 1 l)) "," (cdr (assoc 2 l))) file))
(setq l (entget (setq e (entnext e))))
)
)
(close file)
(princ)
)
(gattex)
修改后的代码适用于名为Key Item的块，该块具有两个属性：Item和Quantity。
它可以很好地“搜索”信息。
但是，我希望程序在写入Excel之前对类似“项目”的数量求和。例如
项目数量
消火栓1
消火栓1
希望它在写入Excel之前对数量求和，因此结果是
项目数量
消火栓2
如有修改意见，不胜感激。
（钓鱼去了）
史蒂夫 试一试Steve：
;; Summing Attributes Before Extraction
;; By Lee McDonnell
(defun c:AttSum (/ ss ofile attlst x y lst)
(vl-load-com)
(if (setq ss (ssget "_X" '((0 . "INSERT") (2 . "KEY-ITEM") (66 . 1))))
(progn
(setq ofile (open "c:\\DWG\\RAKE.csv" "a"))
(write-line "ITEM,QUANTITY" ofile)
(setq attlst
(mapcar
(function
(lambda (x)
(mapcar 'vla-get-TextString x)))
(mapcar
(function
(lambda (x)
(vl-sort x
(function
(lambda (x1 x2)
(< (vla-get-TagString x1)
(vla-get-TagString x2)))))))
(mapcar
(function
(lambda (x)
(vlax-safearray->list
(vlax-variant-value
(vla-getAttributes x)))))
(mapcar 'vlax-ename->vla-object
(mapcar 'cadr (ssnamex ss)))))))
(while (setq x (car attlst))
(if (setq y (assoc (car x) lst))
(setq lst (subst (append y (cdr x)) y lst))
(setq lst (cons x lst)))
(setq attlst (cdr attlst)))
(foreach x lst
(write-line
(strcat (car x) (chr 44)
(rtos
(apply '+
(mapcar 'distof (cdr x))))) ofile)))
(princ "\n<!> No Blocks Found <!>"))
(princ))
在将dwg数据写入Excel文件之前，我需要在各自数据的第一行写入图形名称和路径，
（写入行（strcat（getvar“DWGPREFIX”）（getvar“DWGNAME”）
然后在数据的末尾需要写行
---------------------------------------------
要将数据从要附加到同一文件的下一个图形中分离出来，
对于来自同一图形集族的后续图形，重复执行。
为什么Excel文件被锁定且为只读？以前acad打开时从未见过这种情况？需要解锁它。似乎只有在acad完全关闭时才解锁？
（鱼在线上，现在把它卷上来！！！）
史蒂夫
对不起，只读-忘记包含一行来关闭文件（业余错误）。。。
但是数据写入是否正确？数量正确吗？你想让我也为你做晚饭吗？
谢谢你只需要敲9下键你就知道了。。。 试试这个：
;; Summing Attributes Before Extraction
;; By Lee McDonnell
(defun c:AttSum (/ ss ofile attlst x y lst)
(vl-load-com)
(if (setq ss (ssget "_X" '((0 . "INSERT") (2 . "KEY-ITEM") (66 . 1))))
(progn
(setq ofile (open "c:\\DWG\\RAKE.csv" "a"))
(write-line (strcat (getvar "DWGPREFIX") (getvar "DWGNAME")) ofile)
(write-line "ITEM,QUANTITY" ofile)
(setq attlst
(mapcar
(function
(lambda (x)
(mapcar 'vla-get-TextString x)))
(mapcar
(function
(lambda (x)
(vl-sort x
(function
(lambda (x1 x2)
(< (vla-get-TagString x1)
(vla-get-TagString x2)))))))
(mapcar
(function
(lambda (x)
(vlax-safearray->list
(vlax-variant-value
(vla-getAttributes x)))))
(mapcar 'vlax-ename->vla-object
(mapcar 'cadr (ssnamex ss)))))))
(while (setq x (car attlst))
(if (setq y (assoc (car x) lst))
(setq lst (subst (append y (cdr x)) y lst))
(setq lst (cons x lst)))
(setq attlst (cdr attlst)))
(foreach x lst
(write-line
(strcat (car x) (chr 44)
(rtos
(apply '+
(mapcar 'distof (cdr x))))) ofile))
(write-line "-----,-----" ofile)
(close ofile))
(princ "\n<!> No Blocks Found <!>"))
(princ))
如果你已经在做晚饭了。。。哈哈，你知道李，总有一天你需要让他们自己解决剩下的问题。。。尤其是在（文件关闭时）
我知道你的意思，比尔，但是当我确切地知道答案是什么的时候，为什么不让他们摆脱痛苦呢。。。？
所以说实话，你不知道如何将这些信息输入lisp？我不是故意的你说你把最后一个Lisp程序。。。如果这是真的，那么你应该知道如何添加在dwg名称，添加一个单独的行，以及如何关闭文件。。。只是说你不需要鱼的帮助就可以把它钓上来。。。
“鱼”这个词到底是怎么回事？我是比喻中的“鱼”吗？
你可以像freerefill对我做的那样，给他们一个类比，而不是完整的答案。。。哈哈，他们总是逗我开心。
页:
[1]
2