lisp函数提示输入的列表有缺陷
捣鼓了一个lisp函数，将CAD中文字导出到excel文件，然后还可以将该文件导入CAD。但是一直提示相关错误，请大神导入CAD运行下，看看是哪里出了问题。(defun c:ExportToCSV ()
; 获取当前CAD文件名
(setq dwgName (getvar "DWGNAME"))
; 定义CSV文件名
(setq csvFileName (strcat dwgName ".csv"))
; 定义CSV文件路径
(setq csvFilePath (strcat (getvar "DWGPATH") csvFileName))
; 打开CSV文件准备写入
(with-open-file (out csvFilePath "w"
; 选择AutoCAD中的文本对象
(setq ss (ssget "X" "TEXT,MTEXT"))
; 遍历选择集
(while ss
(setq obj (ssname ss 0))
(setq ss (ssname ss 1))
; 获取文本内容、样式、图层等信息
(setq text (cdr (assoc 1 (entget obj))))
(setq style (cdr (assoc 2 (entget obj))))
(setq layer (cdr (assoc 8 (entget obj))))
(setq height (cdr (assoc 40 (entget obj))))
(setq width (cdr (assoc 41 (entget obj))))
; 写入CSV文件
(format out "~A,~A,~A,~A,~A~%" text style layer height width)
)
)
(princ (strcat "\n文本信息已导出到 " csvFilePath))
(princ)
)
(defun c:ImportFromCSV ()
; 获取当前CAD文件名
(setq dwgName (getvar "DWGNAME"))
; 定义CSV文件名
(setq csvFileName (strcat dwgName ".csv"))
; 定义CSV文件路径
(setq csvFilePath (strcat (getvar "DWGPATH") csvFileName))
; 检查CSV文件是否存在
(if (not (vl-filename-exists-p csvFilePath))
(princ "CSV文件不存在。")
(progn
; 打开CSV文件准备读取
(setq in (open csvFilePath "r"))
; 读取CSV文件中的每一行
(while (setq line (read-line in nil nil))
; 分割每行的数据
(setq data (strtok line #\,))
; 依次获取文本内容、样式、图层、高度、宽度
(setq text (car data))
(setq style (cadr data))
(setq layer (caddr data))
(setq height (cadddr data))
(setq width (cadddr data 2))
; 在AutoCAD中搜索原有的文本对象
(setq ss (ssget "X" (strcat "TEXT,'" text "'")))
; 遍历选择集
(while ss
(setq obj (ssname ss 0))
(setq ss (ssname ss 1))
; 更新文本样式、图层、高度、宽度等属性
(command "_.STYLE" obj style)
(command "_.CHANGELAYER" obj layer)
(command "_.TEXTHEIGHT" obj height)
(command "_.TEXTWIDTH" obj width)
)
)
(close in)
(princ (strcat "\n文本信息已从 " csvFilePath "导入并更新。"))
)
)
)
你是直接在TXT里保存的吧要另存为 ANSI格式的 或者在vlisp里保存 你用得AI是假的吧代码错的太离谱了 (defun c:ExportTextToCSV (/ ali1 ali2 ent f fname fpath height i ss style text width)
(setq ss (ssget '((0 . "TEXT,MTEXT"))))
(if ss
(progn
(setq fpath (getvar "DWGPREFIX"))
(setq fname (strcat fpath (vl-filename-base (getvar "DWGNAME")) ".csv"))
(setq f (open fname "w"))
(write-line "Content,Style,Alignment,Height,WidthFactor" f)
(setq i 0)
(repeat (sslength ss)
(setq ent (entget (ssname ss i)))
(setq i (+ i 1))
(setq text (cdr (assoc 1 ent)))
(setq style (cdr (assoc 7 ent)))
(setq ali1 (cdr (assoc 72 ent)))
(setq ali2 (cdr (assoc 73 ent)))
(setq height (cdr (assoc 40 ent)))
(setq width (cdr (assoc 41 ent)))
(write-line (strcat text "," style "," (itoa ali1) "," (itoa ali2) "," (rtos height) "," (rtos width)) f)
)
(close f)
(princ "\n导出完成。")
)
(princ "\n没有选择任何文字对象。")
)
(princ)
)
(defun c:ImportTextFromCSV (/ ali1 ali2 data f fname fpath gd kgb line pt wz zt)
(setq fpath (getvar "DWGPREFIX"))
(setq fname (strcat fpath (vl-filename-base (getvar "DWGNAME")) ".csv"))
(setq f (open fname "r"))
(if f
(progn
(read-line f)
(while (setq line (read-line f))
(setq data (read (strcat "(" (vl-string-translate "," " " line) ")")))
(setq text (vl-princ-to-string (nth 0 data)))
(setq style (vl-princ-to-string (nth 1 data)))
(setq ali1 (nth 2 data))
(setq ali2 (nth 3 data))
(setq height (nth 4 data))
(setq width (nth 5 data))
(setq pt (getpoint "\n指定插入点:"))
(entmake(list '(0 . "text")'(50 . 0.0) (cons 10 pt)(cons 11 pt)(cons 1 text)(cons 7 style)(cons 40 height)'(6 . "Continuous")(cons 41 width)(cons 72 ali1)'(210 0.0 0.0 1.0)'(100 . "AcDbText")(cons 73 ali2)))
)
(close f)
(princ "\n导入完成。")
)
(princ "\n未找到CSV文件。")
)
(princ)
) 飞雪神光 发表于 2024-4-11 00:24
我删除或者增加都不能解决问题，方便帮我调试下吗？谢谢啦 调不了 AI都写不出这么多毛病的代码 飞雪神光 发表于 2024-4-11 11:37
调不了 AI都写不出这么多毛病的代码
大神一看就知道这是AI写的。:'( 飞雪神光 发表于 2024-4-11 11:57
你用得AI是假的吧代码错的太离谱了
所以目前AI还是取代不了人的大脑。
下面的代码是GPT写的，也是有错误。
(defun c:ExportTextToCSV (/ ss i fpath fname ent text style align height width)
;; 选择要导出的文字对象
(setq ss (ssget '((0 . "TEXT,MTEXT"))))
(if ss
(progn
;; 获取CAD文件名用于CSV文件命名
(setq fpath (getvar "DWGPREFIX"))
(setq fname (strcat fpath (vl-filename-base (getvar "DWGNAME")) ".csv"))
;; 打开文件用于写入
(setq f (open fname "w"))
;; 写入CSV头部
(write-line "Content,Style,Alignment,Height,WidthFactor" f)
;; 遍历选择集
(repeat (sslength ss)
(setq ent (entget (ssname ss i)))
(setq i (+ i 1))
;; 获取文字内容和格式信息
(setq text (cdr (assoc 1 ent)))
(setq style (cdr (assoc 7 ent)))
(setq align (cdr (assoc 72 ent)))
(setq height (cdr (assoc 40 ent)))
(setq width (cdr (assoc 41 ent)))
;; 写入到CSV文件
(write-line (strcat text "," style "," (itoa align) "," (rtos height) "," (rtos width)) f)
)
;; 关闭文件
(close f)
(princ "\n导出完成。")
)
(princ "\n没有选择任何文字对象。")
)
(princ)
)
(defun c:ImportTextFromCSV (/ fpath fname f line data ent pt)
;; 获取CAD文件名用于查找CSV文件
(setq fpath (getvar "DWGPREFIX"))
(setq fname (strcat fpath (vl-filename-base (getvar "DWGNAME")) ".csv"))
;; 打开文件用于读取
(setq f (open fname "r"))
(if f
(progn
;; 跳过CSV头部
(read-line f)
;; 循环读取每一行
(while (setq line (read-line f))
;; 解析CSV行
(setq data (read (strcat "(" (subst "," " " (vl-string-translate "," " " line)) ")")))
;; 创建新的文字对象
(command "._mtext" (getpoint "\n指定插入点: ") "Height" (nth 3 data) (strcat (nth 0 data)))
)
;; 关闭文件
(close f)
(princ "\n导入完成。")
)
(princ "\n未找到CSV文件。")
)
(princ)
) 嗯 代码还是有点毛病 飞雪神光 发表于 2024-4-11 14:51
嗯 代码还是有点毛病
大神可以帮忙调整下这段代码吗？不胜感激 论坛搜一搜都有现成的，需要AI写？
页:
[1]
2