扩展属性查看编辑小工具

vectra

使用GET命令将选定对象的扩展数据导出为文本文件，手工编辑此文本文件后保存，再执行PUT命令可以把修改后的扩展数据存回选定的对象。

特性：
1、100% 纯LISP代码，无插件、扩展组件要求
2、3.5K 超小代码长度。

已知问题：
1、当数据文件中含 有多个1001段时，需要手动注册appid，否则写回XDATA操作会失败
2、浮点数在交换过程中可能损失精度

下面是源码：

1. (defun op-ensure-object        (obj)
   
2.   (if (= 'ename (type obj))
   
3.     (vlax-ename->vla-object obj)
   
4.     obj
   
5.   )
   
6. )
   
7. 
   
8. (defun op-xdata-get (obj appname / xtypeout xdataout)
   
9.   (setq obj (op-ensure-object obj))
   
10. 
    
11.   (vla-getxdata obj appname 'xtypeout 'xdataout)
    
12.   (if (null xtypeout)
    
13.     nil
    
14.     (mapcar '(lambda (a b) (cons a b))
    
15.             (vlax-safearray->list xtypeout)
    
16.             (mapcar '(lambda (e)
    
17.                        (if (>= (vlax-variant-type e) 8192)
    
18.                          (vlax-safearray->list (vlax-variant-value e))
    
19.                          (vlax-variant-value e)
    
20.                        )
    
21.                      )
    
22.                     (vlax-safearray->list xdataout)
    
23.             )
    
24.     )
    
25.   )
    
26. )
    
27. ;; (op-xdata-get (vlax-ename->vla-object (car (entsel))) "")
    
28. 
    
29. 
    
30. 
    
31. (defun op-xdata-set (obj xdata / datatype data)
    
32.   (setq obj (op-ensure-object obj))
    
33. 
    
34.   (setq        datatype (vlax-make-safearray
    
35.                    vlax-vbinteger
    
36.                    (cons 0 (1- (length xdata)))
    
37.                  )
    
38.         data         (vlax-make-safearray
    
39.                    vlax-vbvariant
    
40.                    (cons 0 (1- (length xdata)))
    
41.                  )
    
42.   )
    
43.   (vlax-safearray-fill datatype (mapcar 'car xdata))
    
44.   (vlax-safearray-fill
    
45.     data
    
46.     (mapcar '(lambda (e)
    
47.                (if (listp e)
    
48.                  (vlax-3d-point e)
    
49.                  e
    
50.                )
    
51.              )
    
52.             (mapcar 'cdr xdata)
    
53.     )
    
54.   )
    
55. 
    
56.   (vla-setxdata obj datatype data)
    
57. )
    
58. ;; (op-xdata-set (vlax-ename->vla-object (car (entsel))) '((1001 . "1")))
    
59. 
    
60. 
    
61. (defun op-xdata-remove (obj appname /)
    
62.   (setq obj (op-ensure-object obj))
    
63.   (op-xdata-set obj (list (cons 1001 appname)))
    
64. )
    
65. 
    
66. 
    
67. 
    
68. (defun op-string-tokenize (str delim / buff l2)
    
69.   (setq        str   (vl-string->list str)
    
70.         delim (ascii delim)
    
71.   )
    
72.   (while str
    
73.     (if        (= (car str) delim)
    
74.       (setq l2         (cons (vl-list->string (reverse buff)) l2)
    
75.             buff nil
    
76.       )
    
77.       (setq buff (cons (car str) buff))
    
78.     )
    
79.     (setq str (cdr str))
    
80.   )
    
81.   (if buff
    
82.     (setq l2 (cons (vl-list->string (reverse buff)) l2))
    
83.   )
    
84.   (reverse l2)
    
85. )
    
86. ;;;_$ (op-string-tokenize "AA,1500,800,150" ",")
    
87. ;;;("AA" "1500" "800" "150")
    
88. 
    
89. 
    
90. 
    
91. (defun op-read-csvfile (filename / file line table)
    
92.   (if (setq file (open filename "r"))
    
93.     (progn
    
94.       (while (setq line (read-line file))
    
95.         (setq line (vl-string-trim " \t\n," line))
    
96. 
    
97.         (if (/= line "")
    
98.           (setq        line  (op-string-tokenize line "\t")
    
99.                 line  (mapcar '(lambda (e) (vl-string-trim " \"" e)) line)
    
100.                 table (cons line table)
     
101.           )
     
102.         )
     
103.       )
     
104.       (close file)
     
105.     )
     
106.   )
     
107.   (reverse table)
     
108. )
     
109. 
     
110. 
     
111. (defun c:put (/ DATA E GRC GRV)
     
112.   (setq data (op-read-csvfile op-last-swapfilename))
     
113.   (setq        data (mapcar '(lambda (e)
     
114.                         (setq grc (atoi (car e))
     
115.                               grv (cadr e)
     
116.                         )
     
117.                         (cond ((and (>= grc 1010)
     
118.                                     (<= grc 1013)
     
119.                                )
     
120.                                (if (null grv)
     
121.                                  (setq grv '(0 0 0))
     
122.                                  (setq grv (vl-string-trim " ()" grv)
     
123.                                        grv (mapcar
     
124.                                              'atof
     
125.                                              (op-string-tokenize grv " ")
     
126.                                            )
     
127.                                  )
     
128.                                )
     
129.                               )
     
130. 
     
131.                               ((= grc 1040)
     
132.                                (if (null grv)
     
133.                                  (setq grv 0.0)
     
134.                                  (setq grv (atof grv))
     
135.                                )
     
136.                               )
     
137. 
     
138.                               ((or (= grc 1070)
     
139.                                    (= grc 1071)
     
140.                                )
     
141.                                (if (null grv)
     
142.                                  (setq grv 0)
     
143.                                  (setq grv (atoi grv))
     
144.                                )
     
145.                               )
     
146. 
     
147.                               (t
     
148.                                (if (null grv)
     
149.                                  (setq grv "")
     
150.                                )
     
151.                               )
     
152.                         )
     
153.                         (cons grc grv)
     
154.                       )
     
155.                      data
     
156.              )
     
157.   )
     
158.   (op-xdata-set op-last-object data)
     
159.   (princ)
     
160. )
     
161. 
     
162. (defun c:get (/ data e grc grv)
     
163.   (setq        op-last-object (vlax-ename->vla-object (car (entsel)))
     
164.         data               (op-xdata-get op-last-object "")
     
165.   )
     
166. 
     
167.   (if (null op-last-swapfilename)
     
168.     (setq op-last-swapfilename (vl-filename-mktemp "XDATA.txt"))
     
169.   )
     
170. 
     
171.   (setq f (open op-last-swapfilename "w"))
     
172. 
     
173.   (foreach e data
     
174.     (setq str (strcat (itoa (car e)) "\t" (vl-princ-to-string (cdr e))))
     
175.     (write-line str f)
     
176.   )
     
177. 
     
178.   (close f)
     
179. 
     
180.   (startapp "notepad" op-last-swapfilename)
     
181.   (princ)
     
182. )
     
183. 
     

(defun op-ensure-object        (obj)<br />   (if (= 'ename (type obj))<br />     (vlax-ename->vla-object obj)<br />     obj<br />   )<br /> )<br /> <br /> (defun op-xdata-get (obj appname / xtypeout xdataout)<br />   (setq obj (op-ensure-object obj))<br /> <br />   (vla-getxdata obj appname 'xtypeout 'xdataout)<br />   (if (null xtypeout)<br />     nil<br />     (mapcar '(lambda (a b) (cons a b))<br />             (vlax-safearray->list xtypeout)<br />             (mapcar '(lambda (e)<br />                        (if (>= (vlax-variant-type e) 8192)<br />                          (vlax-safearray->list (vlax-variant-value e))<br />                          (vlax-variant-value e)<br />                        )<br />                      )<br />                     (vlax-safearray->list xdataout)<br />             )<br />     )<br />   )<br /> )<br /> ;; (op-xdata-get (vlax-ename->vla-object (car (entsel))) "")<br /> <br /> <br /> <br /> (defun op-xdata-set (obj xdata / datatype data)<br />   (setq obj (op-ensure-object obj))<br /> <br />   (setq        datatype (vlax-make-safearray<br />                    vlax-vbinteger<br />                    (cons 0 (1- (length xdata)))<br />                  )<br />         data         (vlax-make-safearray<br />                    vlax-vbvariant<br />                    (cons 0 (1- (length xdata)))<br />                  )<br />   )<br />   (vlax-safearray-fill datatype (mapcar 'car xdata))<br />   (vlax-safearray-fill<br />     data<br />     (mapcar '(lambda (e)<br />                (if (listp e)<br />                  (vlax-3d-point e)<br />                  e<br />                )<br />              )<br />             (mapcar 'cdr xdata)<br />     )<br />   )<br /> <br />   (vla-setxdata obj datatype data)<br /> )<br /> ;; (op-xdata-set (vlax-ename->vla-object (car (entsel))) '((1001 . "1")))<br /> <br /> <br /> (defun op-xdata-remove (obj appname /)<br />   (setq obj (op-ensure-object obj))<br />   (op-xdata-set obj (list (cons 1001 appname)))<br /> )<br /> <br /> <br /> <br /> (defun op-string-tokenize (str delim / buff l2)<br />   (setq        str   (vl-string->list str)<br />         delim (ascii delim)<br />   )<br />   (while str<br />     (if        (= (car str) delim)<br />       (setq l2         (cons (vl-list->string (reverse buff)) l2)<br />             buff nil<br />       )<br />       (setq buff (cons (car str) buff))<br />     )<br />     (setq str (cdr str))<br />   )<br />   (if buff<br />     (setq l2 (cons (vl-list->string (reverse buff)) l2))<br />   )<br />   (reverse l2)<br /> )<br /> ;;;_$ (op-string-tokenize "AA,1500,800,150" ",")<br /> ;;;("AA" "1500" "800" "150")<br /> <br /> <br /> <br /> (defun op-read-csvfile (filename / file line table)<br />   (if (setq file (open filename "r"))<br />     (progn<br />       (while (setq line (read-line file))<br />         (setq line (vl-string-trim " \t\n," line))<br /> <br />         (if (/= line "")<br />           (setq        line  (op-string-tokenize line "\t")<br />                 line  (mapcar '(lambda (e) (vl-string-trim " \"" e)) line)<br />                 table (cons line table)<br />           )<br />         )<br />       )<br />       (close file)<br />     )<br />   )<br />   (reverse table)<br /> )<br /> <br /> <br /> (defun c:put (/ DATA E GRC GRV)<br />   (setq data (op-read-csvfile op-last-swapfilename))<br />   (setq        data (mapcar '(lambda (e)<br />                         (setq grc (atoi (car e))<br />                               grv (cadr e)<br />                         )<br />                         (cond ((and (>= grc 1010)<br />                                     (<= grc 1013)<br />                                )<br />                                (if (null grv)<br />                                  (setq grv '(0 0 0))<br />                                  (setq grv (vl-string-trim " ()" grv)<br />                                        grv (mapcar<br />                                              'atof<br />                                              (op-string-tokenize grv " ")<br />                                            )<br />                                  )<br />                                )<br />                               )<br /> <br />                               ((= grc 1040)<br />                                (if (null grv)<br />                                  (setq grv 0.0)<br />                                  (setq grv (atof grv))<br />                                )<br />                               )<br /> <br />                               ((or (= grc 1070)<br />                                    (= grc 1071)<br />                                )<br />                                (if (null grv)<br />                                  (setq grv 0)<br />                                  (setq grv (atoi grv))<br />                                )<br />                               )<br /> <br />                               (t<br />                                (if (null grv)<br />                                  (setq grv "")<br />                                )<br />                               )<br />                         )<br />                         (cons grc grv)<br />                       )<br />                      data<br />              )<br />   )<br />   (op-xdata-set op-last-object data)<br />   (princ)<br /> )<br /> <br /> (defun c:get (/ data e grc grv)<br />   (setq        op-last-object (vlax-ename->vla-object (car (entsel)))<br />         data               (op-xdata-get op-last-object "")<br />   )<br /> <br />   (if (null op-last-swapfilename)<br />     (setq op-last-swapfilename (vl-filename-mktemp "XDATA.txt"))<br />   )<br /> <br />   (setq f (open op-last-swapfilename "w"))<br /> <br />   (foreach e data<br />     (setq str (strcat (itoa (car e)) "\t" (vl-princ-to-string (cdr e))))<br />     (write-line str f)<br />   )<br /> <br />   (close f)<br /> <br />   (startapp "notepad" op-last-swapfilename)<br />   (princ)<br /> )<br /> <br />

数据交换文件示例：

1001        TH
1000        A
1000        B
1070        700
1010        (100.0 2300.0 0.0)
1001        TH2
1000        B
1000        B
1070        700
1040        3.12456
1010        (1000.0 2300.0 0.0)
1001        TH3
1000        B
1000        B
1070        700
1040        3.12456
1010        (1000.0 2300.0 0.0)


格式要求：
1、组码与值之间用制表符分隔；
2、必须包含1001段
3、点、三维坐标值以英文括号包含，各数值之间用空格分隔
4、需要移除相应APPID的扩展数据时，仅保留1001段，其余数据删除即可

2017-9-24 更新：批量修改版本

zjy2999

网上搜的：关于AUTOCAD中扩展数据的编辑和修改方法
(defun c:kz(/ code d data dcl_re dclname en ent f gr i ii iii iiii inf key keylst keylst2 kzsj loop lst1 lst2 lw n name nent oldent pd pt ptlst ss str str1 txlst w ww x y zuma);<扩展数据编辑>
(defun *error* (inf)              ; 出错处理
    (setq inf (strcase inf t))
    (if (wcmatch inf "*break*,*cancel*,*exit*,*取消*,*中断*")
      (deltx txlst)
    )
    (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
    (princ)
  )
  (defun jspt (pt w ww)              ; pt相对坐标计算
    (list (+ (car pt) w) (+ (cadr pt) ww))
  )
  (defun dxf (ent n)              ; 取得图元内容
    (if (= (type ent) 'ename)
      (setq ent (entget ent))
    )
    (cdr (assoc n ent))
  )
  (defun emod (ent i n)              ; 替换图元内容
    (subst
      (cons i n)
      (assoc i ent)
      ent
    )
  )
  (defun deltx (txlst / en i x)              ; 删除显示的txlst='(ename0 ename1 ...)
   (foreach x txlst
     (entdel x)
     )
    (setq w 0.0)
    (if lw
      (progn
(setq en (entget lw)
     en (reent en (list '(0.0 0.0) '(0.0 0.0)))
)
(entmod (emod en 43 0.0))
      )
    )
    (if oldent
      (redraw oldent 4)
    )
  )
  (defun wrxdata (name lst / lst1 x)    ; 写入扩展数据1
    (dedata name)
    (setq lst2 '())
    (foreach y lst
      (setq lst1 '())
    (foreach x y
      (cond ((= 1000 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (get_tile x))))))
   ((= 1001 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (get_tile x))))))
   ((= 1002 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (get_tile x))))))
   ((= 1003 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (get_tile x))))))
   ((= 1004 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (get_tile x))))))
   ((= 1005 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (get_tile x))))))
   ((= 1010 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (strtolst (get_tile x)))))))
   ((= 1020 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (strtolst (get_tile x)))))))
   ((= 1030 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (strtolst (get_tile x)))))))
   ((= 1011 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (strtolst (get_tile x)))))))
   ((= 1021 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (strtolst (get_tile x)))))))
   ((= 1031 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (strtolst (get_tile x)))))))
   ((= 1012 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (strtolst (get_tile x)))))))
   ((= 1022 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (strtolst (get_tile x)))))))
   ((= 1032 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (strtolst (get_tile x)))))))
   ((= 1013 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (strtolst (get_tile x)))))))
   ((= 1023 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (strtolst (get_tile x)))))))
   ((= 1033 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (strtolst (get_tile x)))))))
   ((= 1040 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (atof (get_tile x)))))))
   ((= 1041 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (atof (get_tile x)))))))
   ((= 1042 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (atof (get_tile x)))))))
   ((= 1070 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (atoi (get_tile x)))))))
   ((= 1071 (setq zuma (atoi (get_attr x "label"))))(setq lst1 (append lst1 (list(cons zuma (atoi (get_tile x)))))))
   ((wcmatch (setq zuma (get_attr x "label")) "程序名:")(setq lst1 (cons (get_tile x) lst1)))
    )
      )
      (setq lst2 (append lst2  (list lst1)))
      )
    ;(regapp "data1")
    (entmod (append
     (entget name)
     (list (cons -3 lst2)))
   )
  )
  (defun dedata (name)              ; 删除扩展数据
    (entmod (list (cons -1 name) (cons -3 (mapcar
   'list
   (mapcar
     'car
     (cdr (assoc -3 (entget name '("*"))))
   )
)
)
   )
    )
  )
  (defun lsttostr (lst / n str)              ; 表转字符串
    (setq str "")
    (foreach n lst
      (setq str (strcat str (if (= (type n) 'STR) n (rtos n 2 3)) " "))
    )
    str
  )
  (defun strtolst (str / i lst str1)   ; 字符串转表
    (setq lst '()
i 1
    )
    (while (/= str "")
      (if (= (substr str i 1) " ")
(setq str1 (substr str 1 (1- i))
     lst (cons (atof str1) lst)
     str (substr str (1+ i))
     i 1
)
(setq i (1+ i))
      )
    )
    (reverse lst)
  )
  (defun reent (ent ptlst / i nent x)  ; 按点表顺序更新多段线顶点,无须更换的顶点用nil代替。by:langjs
    (setq i -1
nent '()
    )
    (foreach x ent
      (setq nent (append
  nent
  (list (if (and
      (= (car x) 10)
      (/= (nth (setq i (1+ i))
ptlst
  ) nil
      )
    )
  (cons 10 (nth i ptlst))
  x
)
  )
)
      )
    )
  )
  (setvar "cmdecho" 0)              ; 关闭命令响应
  (vl-load-com)
  ;(prompt "\n    鼠标移动查询信息，左键编辑，右键退出！")
  (setq loop t
i 0
txlst '()
  )
  (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 62 186) (cons 90 2) (cons 10 '(0.0 0.0))
(cons 10 '(0.0 0.0))
  )
  )
  (setq lw (entlast))
  (command "DRAWORDER" lw "" "B")
  (while loop
    (setq gr (grread t 4 2)
code (car gr)
pt (cadr gr)
pd nil
    )
    (cond
      ((= code 3)              ; 鼠标左击
       ;(deltx txlst)
(if ent
(progn
   (if (setq kzsj (cdr (assoc -3 (entget ent '("*")))))
     (progn
   (setq dclname (vl-filename-mktemp "yx.dcl")
f (open dclname "w")
   )
   (write-line "yx1:dialog {" f)
   (write-line "label = 扩展数据 ; " f)
   (write-line ":row {"f)
   (write-line ":column {"f)
   (setq ii 0 iiii 0)
   (foreach y kzsj
     (foreach x y
(setq iiii (1+ iiii))
)
     )
   (if (> iiii 15)(progn (setq iii  (1+ (/ iiii 15)))(setq iii (1+ (/ iiii iii))))(setq iii 15))
   (setq  keylst2 '())
   (foreach y kzsj
     (setq keylst '())
     (foreach x y
(setq ii (1+ ii))
(cond ((listp x )
      (cond ((= (car x) 1000) (write-line (strcat "    :edit_box { label =\"" (rtos (car x) 2 0)"\"; key = \"" (setq key (strcat (rtos (car x) 2 0)(itoa ii)))"\" ;value=\""(cdr x)"\";}") f)(setq keylst (append keylst (list  key))))
    ((= (car x) 1001) (write-line (strcat "    :edit_box { label =\"" (rtos (car x) 2 0)"\"; key = \"" (setq key (strcat (rtos (car x) 2 0)(itoa ii)))"\" ;value=\""(cdr x)"\";}") f)(setq keylst (append keylst (list  key))))
    ((= (car x) 1002) (write-line (strcat "    :edit_box { label =\"" (rtos (car x) 2 0)"\"; key = \"" (setq key (strcat (rtos (car x) 2 0)(itoa ii)))"\" ;value=\""(cdr x)"\";}") f)(setq keylst (append keylst (list  key))))
    ((= (car x) 1003) (write-line (strcat "    :edit_box { label =\"" (rtos (car x) 2 0)"\"; key = \"" (setq key (strcat (rtos (car x) 2 0)(itoa ii)))"\" ;value=\""(cdr x)"\";}") f)(setq keylst (append keylst (list  key))))
    ((= (car x) 1004) (write-line (strcat "    :edit_box { label =\"" (rtos (car x) 2 0)"\"; key = \"" (setq key (strcat (rtos (car x) 2 0)(itoa ii)))"\" ;value=\""(cdr x)"\";}") f)(setq keylst (append keylst (list  key))))
    ((= (car x) 1005) (write-line (strcat "    :edit_box { label =\"" (rtos (car x) 2 0)"\"; key = \"" (setq key (strcat (rtos (car x) 2 0)(itoa ii)))"\" ;value=\""(cdr x)"\";}") f)(setq keylst (append keylst (list  key))))
    ((= (car x) 1010) (write-line (strcat "    :edit_box { label =\"" (rtos (car x) 2 0)"\"; key = \"" (setq key (strcat (rtos (car x) 2 0)(itoa ii)))"\" ;value=\""(lsttostr (cdr x))"\";}") f)(setq keylst (append keylst (list  key))))
    ((= (car x) 1020) (write-line (strcat "    :edit_box { label =\"" (rtos (car x) 2 0)"\"; key = \"" (setq key (strcat (rtos (car x) 2 0)(itoa ii)))"\" ;value=\""(lsttostr (cdr x))"\";}") f)(setq keylst (append keylst (list  key))))
    ((= (car x) 1030) (write-line (strcat "    :edit_box { label =\"" (rtos (car x) 2 0)"\"; key = \"" (setq key (strcat (rtos (car x) 2 0)(itoa ii)))"\" ;value=\""(lsttostr (cdr x))"\";}") f)(setq keylst (append keylst (list  key))))
    ((= (car x) 1011) (write-line (strcat "    :edit_box { label =\"" (rtos (car x) 2 0)"\"; key = \"" (setq key (strcat (rtos (car x) 2 0)(itoa ii)))"\" ;value=\""(lsttostr (cdr x))"\";}") f)(setq keylst (append keylst (list  key))))
    ((= (car x) 1021) (write-line (strcat "    :edit_box { label =\"" (rtos (car x) 2 0)"\"; key = \"" (setq key (strcat (rtos (car x) 2 0)(itoa ii)))"\" ;value=\""(lsttostr (cdr x))"\";}") f)(setq keylst (append keylst (list  key))))
    ((= (car x) 1031) (write-line (strcat "    :edit_box { label =\"" (rtos (car x) 2 0)"\"; key = \"" (setq key (strcat (rtos (car x) 2 0)(itoa ii)))"\" ;value=\""(lsttostr (cdr x))"\";}") f)(setq keylst (append keylst (list  key))))
    ((= (car x) 1012) (write-line (strcat "    :edit_box { label =\"" (rtos (car x) 2 0)"\"; key = \"" (setq key (strcat (rtos (car x) 2 0)(itoa ii)))"\" ;value=\""(lsttostr (cdr x))"\";}") f)(setq keylst (append keylst (list  key))))
    ((= (car x) 1022) (write-line (strcat "    :edit_box { label =\"" (rtos (car x) 2 0)"\"; key = \"" (setq key (strcat (rtos (car x) 2 0)(itoa ii)))"\" ;value=\""(lsttostr (cdr x))"\";}") f)(setq keylst (append keylst (list  key))))
    ((= (car x) 1032) (write-line (strcat "    :edit_box { label =\"" (rtos (car x) 2 0)"\"; key = \"" (setq key (strcat (rtos (car x) 2 0)(itoa ii)))"\" ;value=\""(lsttostr (cdr x))"\";}") f)(setq keylst (append keylst (list  key))))
    ((= (car x) 1013) (write-line (strcat "    :edit_box { label =\"" (rtos (car x) 2 0)"\"; key = \"" (setq key (strcat (rtos (car x) 2 0)(itoa ii)))"\" ;value=\""(lsttostr (cdr x))"\";}") f)(setq keylst (append keylst (list  key))))
    ((= (car x) 1023) (write-line (strcat "    :edit_box { label =\"" (rtos (car x) 2 0)"\"; key = \"" (setq key (strcat (rtos (car x) 2 0)(itoa ii)))"\" ;value=\""(lsttostr (cdr x))"\";}") f)(setq keylst (append keylst (list  key))))
    ((= (car x) 1033) (write-line (strcat "    :edit_box { label =\"" (rtos (car x) 2 0)"\"; key = \"" (setq key (strcat (rtos (car x) 2 0)(itoa ii)))"\" ;value=\""(lsttostr (cdr x))"\";}") f)(setq keylst (append keylst (list  key))))
    ((= (car x) 1040) (write-line (strcat "    :edit_box { label =\"" (rtos (car x) 2 0)"\"; key = \"" (setq key (strcat (rtos (car x) 2 0)(itoa ii)))"\" ;value=\""(rtos (cdr x)2 3)"\";}") f)(setq keylst (append keylst (list  key))))
    ((= (car x) 1041) (write-line (strcat "    :edit_box { label =\"" (rtos (car x) 2 0)"\"; key = \"" (setq key (strcat (rtos (car x) 2 0)(itoa ii)))"\" ;value=\""(rtos (cdr x)2 3)"\";}") f)(setq keylst (append keylst (list  key))))
    ((= (car x) 1042) (write-line (strcat "    :edit_box { label =\"" (rtos (car x) 2 0)"\"; key = \"" (setq key (strcat (rtos (car x) 2 0)(itoa ii)))"\" ;value=\""(rtos (cdr x)2 3)"\";}") f)(setq keylst (append keylst (list  key))))
    ((= (car x) 1070) (write-line (strcat "    :edit_box { label =\"" (rtos (car x) 2 0)"\"; key = \"" (setq key (strcat (rtos (car x) 2 0)(itoa ii)))"\" ;value=\""(rtos(cdr x) 2 0)"\";}") f)(setq keylst (append keylst (list  key))))
    ((= (car x) 1071) (write-line (strcat "    :edit_box { label =\"" (rtos (car x) 2 0)"\"; key = \"" (setq key (strcat (rtos (car x) 2 0)(itoa ii)))"\" ;value=\""(rtos(cdr x) 2 0)"\";}") f)(setq keylst (append keylst (list  key))))
    ))
      ((= (type x) 'STR) (write-line (strcat "    :edit_box { label =\"程序名:\"" "; key = \"" (setq key (strcat "key"(itoa ii))) "\" ;value=\""x"\";}") f)(setq keylst (cons key keylst)))
     )
      (if (or (= ii iii)(= ii (* 2 iii))(= ii (* 3 iii))(= ii (* 4 iii))(= ii (* 5 iii))(= ii (* 6 iii))) (progn (write-line " }"f)(write-line ":column {"f)))
     )
     (setq keylst2 (append keylst2 (list keylst)))
     )
   (write-line " }"f)
   (write-line " }"f)
   (write-line "    :row { :button { key = \"e01\" ; label = \"确认\" ;  is_default = true ;   }" f)
   (write-line "           :button { key = \"e02\" ; label = \"取消\" ; is_cancel = true ; } } }" f)
   (close f)
   (setq dcl_re (load_dialog dclname))
   (new_dialog "yx1" dcl_re)
   (setq i 0)
   (action_tile "e01" "(wrxdata ent  keylst2)(done_dialog 1)")
   (start_dialog)
   (unload_dialog dcl_re)
   (vl-file-delete dclname)
)
   (princ "\n没有扩展数据!")
     )
   )

)
      )
      ((= code 5)              ; 鼠标移动
(redraw)
(if (and
     (setq d (* (/ (getvar "viewsize") (cadr (getvar "screensize"))) (getvar "pickbox")))
     (setq ent (nentselp pt)
   ent (if (and ent (= (type (last (last ent))) 'ename))
(last (last ent))
(car ent)
     ))
     (setq kzsj (cdr (assoc -3 (entget ent '("*"))))))
     (progn
(setq ii 0 iiii 0)
   (setq  keylst2 '())
   (foreach y kzsj
     (setq keylst '())
     (foreach x y
(setq ii (1+ ii))
(cond ((listp x )
      (cond ((= (car x) 1000) (setq key (strcat(rtos (car x) 2 0)"      " (cdr x)))(setq keylst (cons key keylst)))
    ((= (car x) 1001) (setq key (strcat(rtos (car x) 2 0)"      " (cdr x)))(setq keylst (cons key keylst)))
    ((= (car x) 1002) (setq key (strcat(rtos (car x) 2 0)"      " (cdr x)))(setq keylst (cons key keylst)))
    ((= (car x) 1003) (setq key (strcat(rtos (car x) 2 0)"      " (cdr x)))(setq keylst (cons key keylst)))
    ((= (car x) 1004) (setq key (strcat(rtos (car x) 2 0)"      " (cdr x)))(setq keylst (cons key keylst)))
    ((= (car x) 1005) (setq key (strcat(rtos (car x) 2 0)"      " (cdr x)))(setq keylst (cons key keylst)))
    ((= (car x) 1010) (setq key (strcat(rtos (car x) 2 0)"      " (lsttostr (cdr x))))(setq keylst (cons key keylst)))
    ((= (car x) 1020) (setq key (strcat(rtos (car x) 2 0)"      " (lsttostr (cdr x))))(setq keylst (cons key keylst)))
    ((= (car x) 1030) (setq key (strcat(rtos (car x) 2 0)"      " (lsttostr (cdr x))))(setq keylst (cons key keylst)))
    ((= (car x) 1011) (setq key (strcat(rtos (car x) 2 0)"      " (lsttostr (cdr x))))(setq keylst (cons key keylst)))
    ((= (car x) 1021) (setq key (strcat(rtos (car x) 2 0)"      " (lsttostr (cdr x))))(setq keylst (cons key keylst)))
    ((= (car x) 1031) (setq key (strcat(rtos (car x) 2 0)"      " (lsttostr (cdr x))))(setq keylst (cons key keylst)))
    ((= (car x) 1012) (setq key (strcat(rtos (car x) 2 0)"      " (lsttostr (cdr x))))(setq keylst (cons key keylst)))
    ((= (car x) 1022) (setq key (strcat(rtos (car x) 2 0)"      " (lsttostr (cdr x))))(setq keylst (cons key keylst)))
    ((= (car x) 1032) (setq key (strcat(rtos (car x) 2 0)"      " (lsttostr (cdr x))))(setq keylst (cons key keylst)))
    ((= (car x) 1013) (setq key (strcat(rtos (car x) 2 0)"      " (lsttostr (cdr x))))(setq keylst (cons key keylst)))
    ((= (car x) 1023) (setq key (strcat(rtos (car x) 2 0)"      " (lsttostr (cdr x))))(setq keylst (cons key keylst)))
    ((= (car x) 1033) (setq key (strcat(rtos (car x) 2 0)"      " (lsttostr (cdr x))))(setq keylst (cons key keylst)))
    ((= (car x) 1040) (setq key (strcat(rtos (car x) 2 0)"      " (rtos(cdr x) 2 3)))(setq keylst (cons key keylst)))
    ((= (car x) 1041) (setq key (strcat(rtos (car x) 2 0)"      " (rtos(cdr x) 2 3)))(setq keylst (cons key keylst)))
    ((= (car x) 1042) (setq key (strcat(rtos (car x) 2 0)"      " (rtos(cdr x) 2 3)))(setq keylst (cons key keylst)))
    ((= (car x) 1070) (setq key (strcat(rtos (car x) 2 0)"      " (rtos(cdr x) 2 0)))(setq keylst (cons key keylst)))
    ((= (car x) 1071) (setq key (strcat(rtos (car x) 2 0)"      " (rtos(cdr x) 2 0)))(setq keylst (cons key keylst)))
    ))
      ((= (type x) 'STR) (setq keylst (cons x keylst)))
     )
      ;(if (or (= ii iii)(= ii (* 2 iii))(= ii (* 3 iii))(= ii (* 4 iii))(= ii (* 5 iii))(= ii (* 6 iii))) (progn (write-line " }"f)(write-line ":column {"f)))
     )
     (setq keylst2 (cons (reverse keylst) keylst2))
     )
     (setq i 0)
   (setq pt (jspt pt d (* -2 d))
i 0
w 0.0
   )
   (redraw)
   (redraw ent 3)
  (if (or (and ent (not oldent))(not (equal oldent ent)))
    (progn
    (if oldent
      (redraw oldent 4)
    )
(if txlst
  (progn
    (while (< 0 (length txlst))
      (entdel (car txlst))
      (setq txlst (cdr txlst))
    )
    (setq oldent nil)
    (if        lw
      (progn
(setq en (entget lw)
     en (reent en (list '(0.0 0.0) '(0.0 0.0)))
)
(entmod (emod en 43 0.0))
      )
    )
  )
)
      (foreach y (reverse keylst2)
(foreach x y
(entmake (list '(0 . "TEXT")
(cons 10 (jspt pt 0 (* -1.5 d i)))
(cons 62 6)
(cons 40 d)
(cons 1 x)
'(41 . 0.9)
  )
)
(setq en (entlast))
;(command "DRAWORDER" en "" "F")
(setq txlst (cons en txlst))
(if (> (car (cadr (textbox (entget en)))) w)
   (setq w (car (cadr (textbox (entget en)))))
)
(setq i (1+ i))
)
      )
    )
    (if txlst
      (progn
(foreach tx (reverse txlst)
      (setq en (entget tx)
   en (emod en 10 (jspt pt 0 (* -1.5 d i)))
   en (emod en 40 d)
      )
      (entmod en)
      (if (> (car (cadr (textbox en))) w)
(setq w (car (cadr (textbox en))))
      )
      (setq i (1+ i))
)
    )
      )
)
   (setq oldent ent)
   (redraw oldent 4)
   (setq h (* -0.75 d (length txlst))
en (entget lw)
en (reent en (list (jspt pt 0 (+ h (* 1.5 d))) (jspt pt (+ (* 0.3 d) w) (+ h (* 1.5 d)))))
en (emod en 43 (+ (* -2 h) (* 0.65 d)))
   )
   (entmod en)
   (redraw)
)
(if txlst
  (progn
    (while (< 0 (length txlst))
      (entdel (car txlst))
      (setq txlst (cdr txlst))
    )
    (setq oldent nil)
    (if        lw
      (progn
(setq en (entget lw)
     en (reent en (list '(0.0 0.0) '(0.0 0.0)))
)
(entmod (emod en 43 0.0))
      )
    )
  )
)
)
      )
      ((or              ; 鼠标右击
(= code 11)
(= code 25)
       )
(deltx txlst)
(setq loop nil)
      )
      (t
      )
    )
  )
  (princ)
)

77077

谢谢楼主分享，
顺便提个小建议，可以将两个命令整合起来。

1. (and
   
2.     (setq ss (ssget '((-3 ("*")))))
   
3.     (setq xdataFile (xdata->file ss))
   
4.     (setq WSshell (vlax-create-object "WScript.Shell"))
   
5.     (vl-catch-all-apply 'vlax-invoke (list WSshell 'run (strcat "notepad.exe " xdataFile) 8 :vlax-true))
   
6.     (vl-catch-all-apply 'vlax-release-object (list WSshell))
   
7.     (fileXdata->objs ss xdataFile)
   
8.     (vl-file-delete xdataFile)
   
9. )

(and<br />     (setq ss (ssget '((-3 ("*")))))<br />     (setq xdataFile (xdata->file ss))<br />     (setq WSshell (vlax-create-object "WScript.Shell"))<br />     (vl-catch-all-apply 'vlax-invoke (list WSshell 'run (strcat "notepad.exe " xdataFile) 8 :vlax-true))<br />     (vl-catch-all-apply 'vlax-release-object (list WSshell))<br />     (fileXdata->objs ss xdataFile)<br />     (vl-file-delete xdataFile)<br /> )

xcz123m

vectra 发表于 2017-9-24 22:40
终于有人提到批量修改问题了，不考虑批量修改，不考虑可以弄进EXCEL或其它工具里辅助编辑，当初为啥要选 ...

批量改全部的吗？？ （所有的属性全一样）            put 还是用不了………………

qhdycm2017

谢谢楼主提供！

yoyoho

感谢分享,回覆学习!!!!!

水吉空

谢谢楼主分享！

永不言弃

谢谢分享              

laiz3000

回复支持一下

819534890

回复学习，学习分享

clh521

看起来不错，收了

天青色

谢谢楼主分享

cuyongping

谢谢分享，呵呵