属性提取到txt-
我已经发现了一个Lisp程序在这个论坛上由米克洛斯Fuccaro（谢谢）这是非常接近我需要的，我已经修改了一些，但仍然有一个问题。Lisp将命名块的属性输出到文本文件，以便导入标签打印软件，这正是我所需要的，但用逗号分隔的文本字符串需要放在一列中。i、 e.a、b、c、d应为
一
b
c
d
我需要保留任何空白属性，这样它们就会产生一个空白行。
代码如下：
; Global ATTribute EXtractor
; by Miklos Fuccaro mfuccaro@hotmail.com
;-------------------------November 2004 -------
;;Edited March 2006 by C. Bassler to allow specification of block and tage names to extract
;;Modified March 2009 by B.Leslie to write Attributes only and name txt file with DWG filename.
(defun gattex()
(setq Blocklist '("Name1" "Name2" "Name3"));; ** edit to include block names to select
(setq TagList '("Tag1" "Tag2" "Tag3"));; ** edit to include tag names to extract
;;create block names separated by columns, for selection filter
(setq Blocknames (List2String BlockList))
(setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 BlockNames))))
(if (not ss) (quit))
(setq Root (getvar "DWGPREFIX"))
(setq file (open (strcat "F:\\ENGINEER\\GENERIC\\Label Schedule\\Extracted Labels\\MK_Equipment_" (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname"))4)) ".TXT") "a") i -1)
(repeat (sslength ss)
(setq Edata (entget (setq e (ssname ss (setq i (1+ i))))))
(while (/= (Dxf 0 Edata) "SEQEND")
(if
(and
(= (Dxf 0 Edata) "ATTRIB")
(member (dxf 2 Edata) TagList);;if tag is on list
);and
(progn
(setq valRow (cons (Dxf 1 Edata) ValRow))
);progn
)
(setq Edata (entget (setq e (entnext e))))
);while
(write-line (List2String (reverse ValRow)) file)
);repeat
(close file)
(princ (strcat "\nDone writing file " Root "MK_Equipment.txt"))
(princ)
);defun
;;-------------------------------
(defun List2String (Alist)
(setq NumStr (length Alist))
(foreach Item AList
(if (= Item (car AList));;first item
(setq LongString (car AList))
(setq LongString (strcat LongString "," Item))
)
)
LongString
);defun
;;--------------------------------
(defun Dxf (code pairs)
(cdr (assoc code pairs))
)
(gattex)
谢谢你的帮助。
布莱恩 未经测试，但试一试：
; Global ATTribute EXtractor
; by Miklos Fuccaro mfuccaro@hotmail.com
;-------------------------November 2004 -------
;;Edited March 2006 by C. Bassler to allow specification of block and tage names to extract
;;Modified March 2009 by B.Leslie to write Attributes only and name txt file with DWG filename.
(defun gattex()
(setq Blocklist '("Name1" "Name2" "Name3"));; ** edit to include block names to select
(setq TagList '("Tag1" "Tag2" "Tag3"));; ** edit to include tag names to extract
;;create block names separated by columns, for selection filter
(setq Blocknames (List2String BlockList))
(setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 BlockNames))))
(if (not ss) (quit))
(setq Root (getvar "DWGPREFIX"))
(setq file (open (strcat "F:\\ENGINEER\\GENERIC\\Label Schedule\\Extracted Labels\\MK_Equipment_" (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname"))4)) ".TXT") "a") i -1)
(repeat (sslength ss)
(setq Edata (entget (setq e (ssname ss (setq i (1+ i))))))
(while (/= (Dxf 0 Edata) "SEQEND")
(if
(and
(= (Dxf 0 Edata) "ATTRIB")
(member (dxf 2 Edata) TagList);;if tag is on list
);and
(progn
(setq valRow (cons (Dxf 1 Edata) ValRow))
);progn
)
(setq Edata (entget (setq e (entnext e))))
);while
(foreach v (reverse ValRow) (write-line v file))
);repeat
(close file)
(princ (strcat "\nDone writing file " Root "MK_Equipment.txt"))
(princ)
);defun
;;-------------------------------
(defun List2String (Alist)
(setq NumStr (length Alist))
(foreach Item AList
(if (= Item (car AList));;first item
(setq LongString (car AList))
(setq LongString (strcat LongString "," Item))
)
)
LongString
);defun
;;--------------------------------
(defun Dxf (code pairs)
(cdr (assoc code pairs))
)
(gattex)
谢谢李，除了重复一遍之外，我还得到了30次同样的数据。 我认为这是因为变量没有本地化，但我可以考虑只编写另一个变量，因为repeat方法无法处理大于32767个实体的选择集。 再次尝试此操作-未经测试：
(defun c:gattex2 (/ Blklst Tglst ss file aEnt)
(setq Blklst '("Name1,Name2,Name3") Tglst '("Tag1" "Tag2" "Tag3"))
(if (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 Blklst) (cons 66 1))))
(progn
(setq file (open (strcat "F:\\ENGINEER\\GENERIC\\Label Schedule\\Extracted Labels\\MK_Equipment_"
(substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname"))4)) ".txt") "a"))
(foreach Ent (mapcar 'cadr (ssnamex ss))
(setq aEnt (entnext Ent))
(while (/= "SEQEND" (cdadr (entget aEnt)))
(if (member (cdr (assoc 2 (entget aEnt))) Tglst)
(write-line (cdr (assoc 1 (entget aEnt))) file))
(setq aEnt (entnext aEnt))))
(close file))
(princ "\n<!> No Blocks Found <!>"))
(princ))
运行时获取此错误-；错误：错误的SSGET列表值 天哪，今天真的不是我的日子！
(defun c:gattex2 (/ Blklst Tglst ss file aEnt)
(setq Blklst "Name1,Name2,Name3" Tglst '("Tag1" "Tag2" "Tag3"))
(if (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 Blklst) (cons 66 1))))
(progn
(setq file (open (strcat "F:\\ENGINEER\\GENERIC\\Label Schedule\\Extracted Labels\\MK_Equipment_"
(substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname"))4)) ".txt") "a"))
(foreach Ent (mapcar 'cadr (ssnamex ss))
(setq aEnt (entnext Ent))
(while (/= "SEQEND" (cdadr (entget aEnt)))
(if (member (cdr (assoc 2 (entget aEnt))) Tglst)
(write-line (cdr (assoc 1 (entget aEnt))) file))
(setq aEnt (entnext aEnt))))
(close file))
(princ "\n<!> No Blocks Found <!>"))
(princ))
我想我应该回去睡觉了 成功了，你现在可以回去睡觉了。
非常感谢你的帮助。 太好了，很高兴对你有用
页:
[1]