属性提取到txt-

RocketBott · 发表于 2022-7-6 14:55:24

我已经发现了一个Lisp程序在这个论坛上由米克洛斯Fuccaro（谢谢）这是非常接近我需要的，我已经修改了一些，但仍然有一个问题。Lisp将命名块的属性输出到文本文件，以便导入标签打印软件，这正是我所需要的，但用逗号分隔的文本字符串需要放在一列中。
i、 e.a、b、c、d应为
一
b
c
d
我需要保留任何空白属性，这样它们就会产生一个空白行。
代码如下：

copy

; Global ATTribute EXtractor 
; by Miklos Fuccaro [email="mfuccaro@hotmail.com"]mfuccaro@hotmail.com[/email] 
;-------------------------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)

谢谢你的帮助。
布莱恩

Lee Mac · 发表于 2022-7-6 15:06:59

未经测试，但试一试：

copy


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

RocketBott · 发表于 2022-7-6 15:15:05

谢谢李，除了重复一遍之外，我还得到了30次同样的数据。

Lee Mac · 发表于 2022-7-6 15:18:18

我认为这是因为变量没有本地化，但我可以考虑只编写另一个变量，因为repeat方法无法处理大于32767个实体的选择集。

Lee Mac · 发表于 2022-7-6 15:26:04

再次尝试此操作-未经测试：

copy


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

RocketBott · 发表于 2022-7-6 15:37:52

运行时获取此错误-；错误：错误的SSGET列表值

Lee Mac · 发表于 2022-7-6 15:42:22

天哪，今天真的不是我的日子！

copy


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