社区 › Auto Lisp › 保存“文本”及其坐标

Wojciech 发表于 2022-7-5 23:32:43

保存“文本”及其坐标

你好
 
我想保存“文本”及其坐标到txt文件。
 
我有一些剧本：
 
(defun c:TextToFIle( / *error* allText lenTxt idx fName txtFile dName
thisTxtObj thisText)
(vl-load-com)
(defun *error*(msg)
(if msg
(if txtFile
(progn
(close txtfile)
(setq txtFile nil)
(gc)
)
)
)
)
(setq allText(ssget"x"(list(cons 0 "Text"))))
(if allText
(progn
(princ(strcat(itoa(setq lenTxt(sslength allText)))" text objects to
export"))
(setq idx -1)
(setq fName(strcat(getvar"DwgPrefix")(setq
dName(vl-filename-base(getvar"Dwgname")))"-Text.txt"))
(setq txtFile(open fName "w"))


(repeat lenTxt
(setq thisTxtObj
(vlax-ename->vla-object(ssname allText (setq idx(1+ idx))))
thisText (vla-get-textstring thisTxtObj))
(write-line thisText txtFile)
);repeat
(close txtFile)
(setq txtFile nil)
(gc)
(princ"\nDone writing to file")
);progn
);if text
(princ)
)
 
它将所有“文本”保存到txt文件中。我也想保存它们的坐标。
 
类似这样：
 
十、 Y，文本
21233.13123、28402.37293、文本1
21224.2532528443.21432，文本2
等
 
对我的英语表示问候和抱歉

hmsilva 发表于 2022-7-5 23:44:15

也许是这样的。。。

(setq thisTxtObj (vlax-ename->vla-object(ssname allText (setq idx(1+ idx))))
   ipt (vlax-get thisTxtObj 'InsertionPoint)
   xdata (rtos (car ipt))
   ydata (rtos (cadr ipt))
   thisText (vla-get-textstring thisTxtObj))
(write-line (strcat xdata ", " ydata ", " thisText) txtFile))

 
HTH公司
亨里克

Tharwat 发表于 2022-7-5 23:48:22

欢迎来到CADTutor。
 
试试这个。。。
 

(defun c:Test (/ ss fl o)
;; Tharwat 21. Feb. 2014    ;;
(if (and (setq ss (ssget '((0 . "TEXT")(8 . "Dz 02,Dz 02 new"))))
          (setq fl (strcat (getvar 'DWGPREFIX) (vl-filename-base (getvar 'DWGNAME)) ".txt"))
          )
   (progn
   (setq o (open fl "w"))
   (write-line (strcat "X," "\t" "Y," "\t" "Text") o)
   ((lambda (x / e p)
      (while (setq e (ssname ss (setq x (1+ x))))
      (setq p (cdr (assoc 10 (entget e))))
      (write-line (strcat (rtos (car p) 2) "\t" (rtos (cadr p) 2) "\t" (cdr (assoc 1 (entget e)))) o)
      ))
   -1)
   (close o))
   )
(if fl (startapp "Notepad" fl))
(princ)
)

David Bethel 发表于 2022-7-5 23:54:17

这可能是一个基本的引擎。
 
文本对齐或旋转时会出现问题。ie是第10组或第11组所需的坐标：
 

(defun c:extxt (/ wf ss i en ed tx ip ap)
(setq wf (open (strcat (getvar "DWGPREFIX") "\\-TEXT.TXT") "w"))
(and (setq ss (ssget '((0 . "TEXT"))))
      (setq i 0)
      (while (setq en (ssname ss i))
             (setq ed (entget en)
                   tx (cdr (assoc1 ed))
                   ip (cdr (assoc 10 ed))
                   ap (cdr (assoc 11 ed)))
             (prin1 ip wf)
             (princ " " wf)
             (prin1 ap wf)
             (princ " " wf)
             (prin1 tx wf)
             (write-line "" wf)
             (setq i (1+ i))))
(close wf)
(prin1))

 
 
HTH-David
测试。图纸

Wojciech 发表于 2022-7-6 00:05:59

非常感谢。我喜欢塔瓦特的剧本，但它有很大的问题。它没有选择功能。我必须有这个功能（最好有这个功能，包括使用隔离层）。
 
David Bethel，我希望我可以假设我不必使用“ap（cdr（assoc 11 ed））”。

Tharwat 发表于 2022-7-6 00:11:06

 
不客气。
 
 
这不是什么大问题，选择集中只包括哪些层名称？

Wojciech 发表于 2022-7-6 00:14:33

“Dz 02”和“Dz 02 new”

Tharwat 发表于 2022-7-6 00:19:43

我更新了上面的代码，试试看，然后告诉我

Wojciech 发表于 2022-7-6 00:27:16

感谢上传脚本。我说得对吗，那个名字层不能有“#”符号？这样地：
 
(if (and (setq ss (ssget '((0 . "TEXT")(8 . "Layer #2"))))

Tharwat 发表于 2022-7-6 00:34:32

(8 . "*2")

查看完整版本: 保存“文本”及其坐标