我写的蹩脚的程序！

chq168168

我写了个提取cad中的文字、坐标、图层、颜色的程序，太不理想了（非常蹩脚），有大哥能给改下改成用vla对象写的么？

2. (defun c:Q2(/ ff ffn i ss ssdata ssn sstyp sx sy sz txt txtxy)
   
3.    (setvar "cmdecho" 0) ;;关闭变量
   
4. (setvar "blipmode" 0);;关闭控制点
   
5. (vl-load-com)        ;;加载vlax扩展函数
   
6.   
   
7.   
   
8.   
   
9.   ;(setq ffn (getfiled "写出文件" "C:/Users/Administrator/Desktop/" "csv" 1))  ;弹对话框提示设置保存路径及名称
   
10.   (princ "\n选取文字:")                                                      ;提示选取文字
    
11.   (setq ff (open "C://Users//Administrator//Desktop//文字.xls"  "w"))   ;建立文本;W会把文本里面的内容清除         
    
12.   (setq i 0 ss '())                                                                  ;设置i初始值
    
13.   (if (setq ss (ssget '((0 . "*TEXT"))))                                      ;星号通配符，TEXT或者MTEXT都可以。
    
14.     (repeat (sslength ss)                                                       ;对循环体中的表达式求SS图元个数值
    
15.       (setq ssn (ssname ss i))                                                    ;返回SS集中第i个图元名称
    
16.       (setq ssdata (entget ssn))                                                  ;返回图元的数据集
    
17.       (setq txt (cdr (assoc 1 ssdata)))                                           ;取文本数值
    
18.       (setq txtxy (cdr (assoc 10 ssdata)))                                         ;取文本坐标
    
19.       (setq sx (rtos (nth 1 txtxy) 2 3))                                              ;将X坐标值实数转换成字符（目前没单独提取）
    
20.       (setq sy (rtos (nth 0 txtxy) 2 3))                                              ;将y坐标值实数转换成字符（目前没单独提取）
    
21.       (setq sz (rtos (nth 2 txtxy) 2 3))                                              ;将z坐标值实数转换成字符（目前没单独提取）
    
22.       (setq tc (cdr (assoc 8 ssdata)))
    
23.       (progn
    
24.        (or
    
25.         (setq col(cdr(assoc 62 ssdata)))
    
26.         (setq col(cdr(assoc 62(tblsearch "layer" tc))))                        ;随层颜色提取方式
    
27.        )
    
28.           col
    
29.       )
    
30.       
    
31.       (princ txt ff)
    
32.       (princ "\t" ff);这个格式就是在同一行下一个内容
    
33.       (princ txtxy ff)
    
34.       (princ "\t" ff);这个格式就是在同一行下一个内容
    
35.       (princ tc ff)
    
36.       (princ "\t" ff);这个格式就是在同一行下一个内容
    
37.       (princ col ff)
    
38.       (princ "\t" ff);这个格式就是在同一行下一个内容
    
39.       (princ sx ff)
    
40.       (princ "\t" ff);这个格式就是在同一行下一个内容
    
41.       (princ sy ff)
    
42.       (princ "\t" ff);这个格式就是在同一行下一个内容
    
43.       (princ sz ff)
    
44.       (princ "\t" ff);这个格式就是在同一行下一个内容
    
45.       (princ "\n" ff);这个格式就换行
    
46.       ;write-line不用换行,princ要用/n换行,princ要用/t下一列，（在同一行下一个内容）
    
47.       (setq i (1+ i))
    
48.     )
    
49.   )
    
50.      (close ff)                           ;关闭ff文件
    
51.   ;(princ (strcat "\n写出文件 " ffn))   ;提示提取文字完成
    
52.      (princ)                              ;让提示行只显示一行
    
53. )

(defun c:Q2(/ ff ffn i ss ssdata ssn sstyp sx sy sz txt txtxy)<br />    (setvar "cmdecho" 0) ;;关闭变量<br /> (setvar "blipmode" 0);;关闭控制点<br /> (vl-load-com)        ;;加载vlax扩展函数<br />   <br />   <br />   <br />   ;(setq ffn (getfiled "写出文件" "C:/Users/Administrator/Desktop/" "csv" 1))  ;弹对话框提示设置保存路径及名称<br />   (princ "\n选取文字:")                                                      ;提示选取文字<br />   (setq ff (open "C://Users//Administrator//Desktop//文字.xls"  "w"))   ;建立文本;W会把文本里面的内容清除         <br />   (setq i 0 ss '())                                                                  ;设置i初始值<br />   (if (setq ss (ssget '((0 . "*TEXT"))))                                      ;星号通配符，TEXT或者MTEXT都可以。<br />     (repeat (sslength ss)                                                       ;对循环体中的表达式求SS图元个数值<br />       (setq ssn (ssname ss i))                                                    ;返回SS集中第i个图元名称<br />       (setq ssdata (entget ssn))                                                  ;返回图元的数据集<br />       (setq txt (cdr (assoc 1 ssdata)))                                           ;取文本数值<br />       (setq txtxy (cdr (assoc 10 ssdata)))                                         ;取文本坐标<br />       (setq sx (rtos (nth 1 txtxy) 2 3))                                              ;将X坐标值实数转换成字符（目前没单独提取）<br />       (setq sy (rtos (nth 0 txtxy) 2 3))                                              ;将y坐标值实数转换成字符（目前没单独提取）<br />       (setq sz (rtos (nth 2 txtxy) 2 3))                                              ;将z坐标值实数转换成字符（目前没单独提取）<br />       (setq tc (cdr (assoc 8 ssdata)))<br />       (progn<br />        (or<br />         (setq col(cdr(assoc 62 ssdata)))<br />         (setq col(cdr(assoc 62(tblsearch "layer" tc))))                        ;随层颜色提取方式<br />        )<br />           col<br />       )<br />       <br />       (princ txt ff)<br />       (princ "\t" ff);这个格式就是在同一行下一个内容<br />       (princ txtxy ff)<br />       (princ "\t" ff);这个格式就是在同一行下一个内容<br />       (princ tc ff)<br />       (princ "\t" ff);这个格式就是在同一行下一个内容<br />       (princ col ff)<br />       (princ "\t" ff);这个格式就是在同一行下一个内容<br />       (princ sx ff)<br />       (princ "\t" ff);这个格式就是在同一行下一个内容<br />       (princ sy ff)<br />       (princ "\t" ff);这个格式就是在同一行下一个内容<br />       (princ sz ff)<br />       (princ "\t" ff);这个格式就是在同一行下一个内容<br />       (princ "\n" ff);这个格式就换行<br />       ;write-line不用换行,princ要用/n换行,princ要用/t下一列，（在同一行下一个内容）<br />       (setq i (1+ i))<br />     )<br />   )<br />      (close ff)                           ;关闭ff文件<br />   ;(princ (strcat "\n写出文件 " ffn))   ;提示提取文字完成<br />      (princ)                              ;让提示行只显示一行<br /> )

CAD带文字的文件我就不传了，随便在CAD中新建几个文字提取试试就行。先谢谢大神了哈，我这是在研究CAD跟excel的转换问题，没整明白。

花开富贵

;;;;声明，下面的这些子函数我只是在原有基础修改，并非原创，请记住是这个人写的：落魄山人
(Defun Excel:WorkBooks-Add (ExcelApp FileName ishide / ExcelApp)
        ;;;示例(Excel:WorkBooks-Add ExcelApp "e:\\test.xlsx" t)
  ;(if (setq ExcelApp (vlax-get-or-create-object "Excel.Application"))
    (progn
      (setq newBooks(vlax-invoke
                                (vlax-get-property ExcelApp 'WorkBooks)
                                'Add
      ))
                        (if FileName (vlax-invoke newBooks "SaveAs" Filename));;;这里不能使用vlax-invoke-method
                 
      (if ishide
                                (vla-put-visible ExcelApp 1)
                                (vla-put-visible ExcelApp 0)
      )
    )
  ;)
  newBooks
)

(Defun Excel:Range:Value-Put (ExcelApp index value / range)
  (setq range (Excel:Range-Get ExcelApp SheetSpecify index))
  (if (= 'list (type value))
    (progn
                        (setq value$ (if (= 'list (type (car value))) (apply 'append value) value))
      (vlax-for        it range;;;对range对象，从左往右，再从上往下遍历，如"H10:I11"，先后顺序为H10 H11  I10 I11
                                (PutP it 'value2 (car value$))
                                (setq value$ (cdr value$))
      )
    )
    (progn
      (vlax-for        it range
                                (PutP it 'value2 value)
      )
    )
  )
)

(defun Excel:Range-Get (ExcelApp SheetSpecify indexRange)
       
  (vlax-get-property
    (if SheetSpecify SheetSpecify(GetP ExcelApp "ActiveWorkbook.ActiveSheet"))
    'range
    (Excel:Index2A1 indexRange)
  )
)


(defun Excel:Index2A1 (lst / num->col)
;;;(Excel:Index2A1 '(1 2 3 4))->"B1:D3" (Excel:Index2A1 '(1 2 ))->"B1"
       
        ;;说明:把数字转换为字母，转换规律为如1-26转换为字母A-Z，相当于十进制转换为27进制,不是26，隐藏了一个0
        ;;参数:n:数字，不限范围
        ;;返回:字符串，字母A-Z-ZZZZ......
  (defun num->col (n)                        ;数字转为列，leemac
    (if        (< n 27)
      (chr (+ 64 n))
      (strcat
                                (num->col (/ (1- n) 26))
                                (num->col (1+ (rem (1- n) 26)))
      )
    )
  )
  (if (= 'list (type lst))
    (cond
      ((= 2 (length lst))
                                (strcat (num->col (cadr lst)) (itoa (car lst)))
      )
      ((= 4 (length lst))
                                (strcat (num->col (cadr lst))
                                        (itoa (car lst))
                                        ":"
                                        (num->col (last lst))
                                        (itoa (caddr lst))
                                )
      )
      (t
                                "A1"
      )
    )
    lst
  )
)

(defun GetP (obj prop / Rtn Rtn2)
  (cond        ((= (type prop) 'sym)
                                                                 (if(vl-catch-all-error-p(setq Rtn2(vl-catch-all-apply 'vlax-get-property (list obj prop) )))
                                                                         (princ(strcat"\n不具备属性:" (vl-prin1-to-string(eval(quote prop))))) (setq Rtn Rtn2) )
                                                                 
                                                         )
    ((= (type prop) 'str)
                        (if (null (vl-string-search "." prop))
                                (if(vl-catch-all-error-p(setq Rtn2(vl-catch-all-apply 'vlax-get-property (list obj prop) )))
                                                                         (princ(strcat"\n不具备属性:" prop)) (setq Rtn Rtn2) )
                               
                               
                                (foreach item (Str:Split prop ".")
                                        (if (null Rtn)
                                                (if(vl-catch-all-error-p(setq Rtn2(vl-catch-all-apply 'vlax-get-property (list obj item) )))
                                                        (princ(strcat"\n不具备属性:" item))(setq Rtn Rtn2) )
                                               
                                                (if(vl-catch-all-error-p(setq Rtn2(vl-catch-all-apply 'vlax-get-property (list Rtn item) )))
                                                        (princ(strcat"\n不具备属性:" item))(setq Rtn Rtn2) )
                                               
                                               
                                               
                                        )
                                )
                        )
    )
  )

  (Excel-Utils-GetValue Rtn)
)


(defun PutP (obj prop value / Rtn Rtn2)
  (cond        ((= (type prop) 'sym)
                                                                 (if(vl-catch-all-error-p(setq Rtn2(vl-catch-all-apply 'vlax-put-property (list obj prop value) )))
                                                                         (princ(strcat"\n不可更改属性:" (vl-prin1-to-string(eval(quote prop))))) (setq Rtn Rtn2) )
                                                                 
                                                         )
    ((= (type prop) 'str)
                        (if (null (vl-string-search "." prop))
                                (if(vl-catch-all-error-p(setq Rtn2(vl-catch-all-apply 'vlax-put-property (list obj prop value) )))
                                                                         (princ(strcat"\n不可更改属性:" prop)) (setq Rtn Rtn2) )
                               
                               
                                (progn
                                        (setq items (Str:Split prop "."))
                                        (foreach item (reverse(cdr(reverse items)))
                                        (if (null Rtn)
                                                (if(vl-catch-all-error-p(setq Rtn2(vl-catch-all-apply 'vlax-get-property (list obj item) )))
                                                        (princ(strcat"\n不具备属性:" item))(setq Rtn Rtn2) )
                                               
                                                (if(vl-catch-all-error-p(setq Rtn2(vl-catch-all-apply 'vlax-get-property (list Rtn item) )))
                                                        (princ(strcat"\n不具备属性:" item))(setq Rtn Rtn2) )
                                               
                                               
                                               
                                        )
                                )
                                        (if(vl-catch-all-error-p(setq Rtn2(vl-catch-all-apply 'vlax-put-property (list Rtn (last items) value) )))
                                                        (princ(strcat"\n不可更改属性:" item)) )
                                )
                        )
    )
  )

  
)

(defun Str:Split (str del / pos)
        (if (setq pos (vl-string-search del str))
                (cons (substr str 1 pos)
                        (Str:Split (substr str (+ pos 1 (strlen del))) del)
                )
                (list str)
        )
)


(defun Excel-Utils-GetValue (var)
  (cond
    ((= 'list (type var))
                        (mapcar 'Excel-Utils-GetValue var)
    )
    ((= 'variant (type var))
                        (Excel-Utils-GetValue
                                (vlax-variant-value
                                        (if (member (vlax-variant-type Var) '(5 4 3 2));;;如果变体类型是双精度 单精度 长整型 整型
                                                (setq Var (vlax-variant-change-type Var vlax-vbString));;;变体类型转换为字符串
                                                var
                                        )
                                )
                        )
    )
    ((= 'safearray (type var))
                        (mapcar 'Excel-Utils-GetValue (vlax-safearray->list var))
    )
    (T var)
  )
)

chq168168

花开富贵 发表于 2023-9-1 15:45
这个写的不挺好吗，是不是觉得不简洁，多练练就好了

大神建议我不用open新建excel我用的vla对象新建的excel，然后就不会写了，下边是我想写的格式，就是想新建一个看不见的excel然后把数据写进去，然后另存一个名字，或者保存，然后关闭。中间获取数据的还是那些，但是就是不好使，不知道为啥。

2. ;;;说明:新建Excel工作簿
   
3. (Defun BF-Excel-New (ishide / Rtn)
   
4.         (if (setq Rtn (vlax-get-or-create-object "Excel.Application"))
   
5.     (progn
   
6.       (vlax-invoke
   
7.                                 (vlax-get-property Rtn 'WorkBooks)
   
8.                                 'Add
   
9.       )
   
10.       (if ishide
    
11.                                 (vla-put-visible Rtn 1)
    
12.                                 (vla-put-visible Rtn 0)
    
13.       )
    
14.     )
    
15.   )
    
16.   Rtn
    
17. )
    
18. 
    
19. ;;;另存为excel文件
    
20. (Defun BF-Excel-SaveAs (XLApp Filename)
    
21.   (vlax-invoke
    
22.     (vlax-get-property XLApp "ActiveWorkbook")
    
23.     "SaveAs"
    
24.     Filename
    
25.   )
    
26. )
    
27. ;;:;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
28. (defun XJB()
    
29.         (vl-load-com)
    
30. (setq ff (BF-Excel-New nil))                                                                  ;新建excel文件
    
31.        
    
32.         (setq i 0 ss '())                                                                  ;设置i初始值
    
33.         (if (setq ss (ssget '((0 . "*TEXT"))))                                             ;星号通配符，TEXT或者MTEXT都可以。
    
34.                 (repeat (sslength ss)                                                            ;对循环体中的表达式求SS图元个数值
    
35.                         (setq ssn (ssname ss i))                                                       ;返回SS集中第i个图元名称
    
36.                         (setq ssdata (entget ssn))                                                     ;返回图元的数据集
    
37.                         (setq txt (cdr (assoc 1 ssdata)))                                              ;取文本数值
    
38.                         (setq txtxy (cdr (assoc 10 ssdata)))                                                  ;取文本坐标
    
39.                         (setq sx (rtos (nth 1 txtxy) 2 3))                                             ;将X坐标值实数转换成字符（目前没单独提取）
    
40.                         (setq sy (rtos (nth 0 txtxy) 2 3))                                             ;将y坐标值实数转换成字符（目前没单独提取）
    
41.                         (setq sz (rtos (nth 2 txtxy) 2 3))                                             ;将z坐标值实数转换成字符（目前没单独提取）
    
42.                         (setq tc (cdr (assoc 8 ssdata)))
    
43.                         (progn
    
44.        (or
    
45.         (setq col(cdr(assoc 62 ssdata)))
    
46.         (setq col(cdr(assoc 62(tblsearch "layer" tc))))                        ;随层颜色提取方式
    
47.        )
    
48.           col
    
49.       )
    
50.                        
    
51.                         (princ txt ff)
    
52.       (princ "\t" ff);这个格式就是在同一行下一个内容
    
53.                         (princ txtxy ff)
    
54.       (princ "\t" ff);这个格式就是在同一行下一个内容
    
55.                         (princ tc ff)
    
56.       (princ "\t" ff);这个格式就是在同一行下一个内容
    
57.                         (princ col ff)
    
58.       (princ "\t" ff);这个格式就是在同一行下一个内容
    
59.                         (princ "\n" ff);这个格式就换行
    
60.                         ;write-line不用换行,princ要用/n换行,princ要用/t下一列，（在同一行下一个内容）
    
61.                         (setq i (1+ i))
    
62.           )
    
63.   )
    
64.           
    
65. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;       
    
66. 
    
67.         (BF-Excel-SaveAs ff "C:\\Users\\administrator\\Desktop\\2.xlsx") ;另存excel文件并重命名为2
    
68.          (close ff)                                                                 ;关闭excel
    
69.         (princ)
    
70. )

;;;说明:新建Excel工作簿<br /> (Defun BF-Excel-New (ishide / Rtn)<br />         (if (setq Rtn (vlax-get-or-create-object "Excel.Application"))<br />     (progn<br />       (vlax-invoke<br />                                 (vlax-get-property Rtn 'WorkBooks)<br />                                 'Add<br />       )<br />       (if ishide<br />                                 (vla-put-visible Rtn 1)<br />                                 (vla-put-visible Rtn 0)<br />       )<br />     )<br />   )<br />   Rtn<br /> )<br /> <br /> ;;;另存为excel文件<br /> (Defun BF-Excel-SaveAs (XLApp Filename)<br />   (vlax-invoke<br />     (vlax-get-property XLApp "ActiveWorkbook")<br />     "SaveAs"<br />     Filename<br />   )<br /> )<br /> ;;:;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (defun XJB() <br />         (vl-load-com)<br /> (setq ff (BF-Excel-New nil))                                                                  ;新建excel文件<br />         <br />         (setq i 0 ss '())                                                                  ;设置i初始值<br />         (if (setq ss (ssget '((0 . "*TEXT"))))                                             ;星号通配符，TEXT或者MTEXT都可以。<br />                 (repeat (sslength ss)                                                            ;对循环体中的表达式求SS图元个数值<br />                         (setq ssn (ssname ss i))                                                       ;返回SS集中第i个图元名称<br />                         (setq ssdata (entget ssn))                                                     ;返回图元的数据集<br />                         (setq txt (cdr (assoc 1 ssdata)))                                              ;取文本数值<br />                         (setq txtxy (cdr (assoc 10 ssdata)))                                                  ;取文本坐标<br />                         (setq sx (rtos (nth 1 txtxy) 2 3))                                             ;将X坐标值实数转换成字符（目前没单独提取）<br />                         (setq sy (rtos (nth 0 txtxy) 2 3))                                             ;将y坐标值实数转换成字符（目前没单独提取）<br />                         (setq sz (rtos (nth 2 txtxy) 2 3))                                             ;将z坐标值实数转换成字符（目前没单独提取）<br />                         (setq tc (cdr (assoc 8 ssdata)))<br />                         (progn<br />        (or<br />         (setq col(cdr(assoc 62 ssdata)))<br />         (setq col(cdr(assoc 62(tblsearch "layer" tc))))                        ;随层颜色提取方式<br />        )<br />           col<br />       )<br />                         <br />                         (princ txt ff)<br />       (princ "\t" ff);这个格式就是在同一行下一个内容<br />                         (princ txtxy ff)<br />       (princ "\t" ff);这个格式就是在同一行下一个内容<br />                         (princ tc ff)<br />       (princ "\t" ff);这个格式就是在同一行下一个内容<br />                         (princ col ff)<br />       (princ "\t" ff);这个格式就是在同一行下一个内容<br />                         (princ "\n" ff);这个格式就换行<br />                         ;write-line不用换行,princ要用/n换行,princ要用/t下一列，（在同一行下一个内容）<br />                         (setq i (1+ i))<br />           )<br />   )<br />           <br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;        <br /> <br />         (BF-Excel-SaveAs ff "C:\\Users\\administrator\\Desktop\\2.xlsx") ;另存excel文件并重命名为2<br />          (close ff)                                                                 ;关闭excel<br />         (princ) <br /> )

花开富贵

;;说明:我写了个提取cad中的文字、坐标、图层、颜色的程序，太不理想了（非常蹩脚）
(defun c:Q2(/ enames ff ss)
        (setvar "cmdecho" 0) ;;关闭变量
        (setvar "blipmode" 0);;关闭控制点
        (vl-load-com)        ;;加载vlax扩展函数
  (setq excelapp(cond((vlax-get-or-create-object "excel.application")) ((vlax-get-or-create-object "ket.application"))))
        (setq ss (ssget '((0 . "*TEXT"))))
        (setq rowRela(sslength ss))
        (setq enames (reverse(mapcar 'cadr (vl-remove-if-not '(lambda(x) (>= (car x) 0) )(ssnamex ss)))))       
        (Excel:WorkBooks-Add excelapp nil t)       
        (Excel:Range:Value-Put excelapp '(1 1 1 6) '("文字"        "x坐标""y坐标""z坐标"        "图层"        "颜色"))
        (Excel:Range:Value-Put excelapp (list 2 1 (+ 2 rowRela) 6)                
                (mapcar
                        '(lambda(x)
                                 (setq ent$(entget x)
                                         coor (cdr(assoc 10 ent$))
                                 )
                                 (list
                                         (cdr(assoc 1 ent$))
                                         (car coor)
                                         (cadr coor)
                                         (last coor)
                                         (cdr(assoc 8 ent$))
                                         (cdr(assoc 62 ent$)))
                                 
                         )
                        enames)
        )
        (princ"\n**********完成**********")
        (princ)                              
)

wzg356

自己知道怎么用的，达到目的就行，有空逛论坛看看例程例句，碎片化吸收学的快一些

花开富贵

(defun c:Q2(/ enames ff ss)
   (setvar "cmdecho" 0) ;;关闭变量
(setvar "blipmode" 0);;关闭控制点
(vl-load-com)        ;;加载vlax扩展函数
  
  
  
  ;(setq ffn (getfiled "写出文件" "C:/Users/Administrator/Desktop/" "csv" 1))  ;弹对话框提示设置保存路径及名称
  (princ "\n选取文字:")                                                      ;提示选取文字
  (setq ff (open "C://Users//Administrator//Desktop//文字.xls"  "w"))   ;建立文本;W会把文本里面的内容清除         
        (setq ss (ssget '((0 . "*TEXT"))))
        (setq enames (reverse(mapcar 'cadr (vl-remove-if-not '(lambda(x) (>= (car x) 0) )(ssnamex ss)))))
        (princ "文字        坐标        图层        颜色\n"ff)
        (mapcar
                '(lambda(x)
                         (setq ent$(entget x))
                         (princ (cdr(assoc 1 ent$)) ff)
                         (princ"\t" ff)
                         
                         (princ (cdr(assoc 10 ent$)) ff)
                         (princ"\t" ff)
                         
                         
                         (princ (cdr(assoc 8 ent$)) ff)
                         (princ"\t" ff)
                         
                         (princ (cdr(assoc 62 ent$)) ff)
                         (princ"\n" ff)
                         
                 )
                enames)
  
     (close ff)                           ;

     (princ)                              
)

renxianjing

楼上大神有宝物
可以搜搜

花开富贵

这个写的不挺好吗，是不是觉得不简洁，多练练就好了

lijiao

可以分开写,一个程序是提取文本的数据为一列表,另一个程序是将列表输出到Excel中,这样程序的通用性会强一些.
建议你先熟悉一下ACAD的对象模型和Excel的对象模型

花开富贵

不会做gif，凑活预览吧