帮忙看看到底哪里有问题?
工作需要用chatGPT弄了个小插件,主要是把CAD里的单行文本提取到文本编辑器里修改,修改完成之后替换回CAD里,其余功能都正常,就是在CAD里选择之后到文本编辑器里的顺序颠倒了,比如CAD里是
1
2
3
4
到了文本编辑器里就变成了
4
3
2
1
虽然修改完保存后之后顺序是对的,但是实在是不方便修改,麻烦各位大佬帮忙修正下
(defun c:WBBJ ()
;; 提示用户选择多个单行文本
(prompt "\nPlease select one or more single-line text objects: ")
(setq textObjList (ssget '((0 . "TEXT")))) ;; 选择所有单行文本
;; 检查是否选择了文本
(if textObjList
(progn
;; 将选择集中的对象存储为列表
(setq textObjArr (list))
(setq i 0)
(while (< i (sslength textObjList))
(setq textObj (ssname textObjList i))
(setq textObjArr (append textObjArr (list textObj)))
(setq i (1+ i))
)
;; 创建临时文件存储所有选中文本内容
(setq tmpFile (strcat (getenv "TEMP") "\\cad_text.txt"))
(setq fileHandle (open tmpFile "w"))
;; 遍历选择集,将每个文本内容逐行写入临时文件
(foreach textObj textObjArr
(setq textContent (cdr (assoc 1 (entget textObj))))
(write-line textContent fileHandle)
)
(close fileHandle)
;; 打开系统自带的文本编辑器编辑文本
(startapp "notepad.exe" tmpFile)
;; 提示用户修改文本并保存
(prompt "\nPlease modify the text in the editor, save and close it, then press any key to continue...\n")
(getstring) ;; 等待用户按下任意键
;; 重新打开临时文件读取修改后的文本
(setq fileHandle (open tmpFile "r"))
;; 遍历选择集,逐行替换文本内容
(foreach textObj textObjArr
(setq newTextContent (read-line fileHandle))
;; 确保读取到了有效的文本内容
(if newTextContent
(progn
;; 替换CAD中的原文本
(entmod (subst (cons 1 newTextContent) (assoc 1 (entget textObj)) (entget textObj)))
(entupd textObj) ;; 更新对象
)
(prompt "\nError: Failed to read new text content.\n")
)
)
(close fileHandle)
(prompt "\nText replacement completed.\n")
)
(prompt "\nNo text objects selected.\n") ;; 如果没有选择文本,提示信息
)
(princ)
)
(setq textObjArr (append textObjArr (list textObj)))改为 (setq textObjArr (append (list textObj)textObjArr))试试 (defun c:tt ()
(defun dxf(code e)(cdr(assoc code(entget e))))
(defun SubUpd(e c v)(entmod(subst(cons c v)(assoc c(entget e))(entget e)))(entupd e))
(defun ss2list(ss)(mapcar'cadr(vl-remove-if-not'(lambda(x)(equal(type(cadr x))'ENAME))(ssnamex ss))))
(prompt "\n选择文本: ")
(if (setq ss (ssget '((0 . "TEXT"))))
(progn
(setq lst(ss2list ss)
lst (vl-sort lst '(lambda (x y) (> (cadr (DXF 10 x)) (cadr (DXF 10 y)))))
txt (strcat (getenv "TEMP") "\\cad_text.txt")
fn(open txt "w")
)
(foreach a lst
(write-line (cdr (assoc 1 (entget a))) fn)
)
(close fn)
(startapp "notepad.exe" txt)
(prompt "\n修改...\n")
(getstring)
(setq fn (open txt "r"))
(foreach a lst
(if (setq tx (read-line fn))
(SubUpd a 1 tx)
)
)
(close fn)
)
)
(princ)
) 13605 发表于 2024-10-22 14:55
(setq textObjArr (append textObjArr (list textObj)))改为 (setq textObjArr (append (list textObj)t ...
我又试了下,还是不太对,文本之类的可以,但是比如我有6行数字,这样改了之后在文本编辑器里顺序直接乱了 13605 发表于 2024-10-22 14:55
(setq textObjArr (append textObjArr (list textObj)))改为 (setq textObjArr (append (list textObj)t ...
太厉害了,一下子就搞定了,非常感谢 太厉害了,一下子就搞定了
这个是CAD附件 wyy81061 发表于 2024-10-22 15:21
我又试了下,还是不太对,文本之类的可以,但是比如我有6行数字,这样改了之后在文本编辑器里顺序直接乱 ...
我又发了个CAD附件,麻烦辛苦测试下 13605 发表于 2024-10-22 14:55
(setq textObjArr (append textObjArr (list textObj)))改为 (setq textObjArr (append (list textObj)t ...
如果有时间的话,能不能麻烦帮我修改一下代码 这个程序有想法,不错! 本帖最后由 wyy81061 于 2024-10-24 08:44 编辑
panliang9 发表于 2024-10-23 17:41
这个程序有想法,不错!
谢谢,楼上的兄弟已经帮我搞定了,其实主要是觉得CAD里编辑太慢了,在别处编辑好直接复制过来更方便
页:
[1]
2