[求助]求批量属性文字转文字

鬼魔

就是还没定义块前的属性文字

转成单行或多行文字都可

SWAYWOOD

估计这段对你有用

2. ((= (cdr (assoc 0 ENTS)) "INSERT")
3.     (setq J (+ J 1))
4.     (princ (strcat "\n正在处理第<"
5.      (itoa (+ J 1))
6.      ">个图元，请稍候..."
7.     )
8.     )
9.     (setq ENTB (tblobjname "block" (cdr (assoc 2 ENTS))))
10.     (setq ENTSB (entget ENTB))
11.     ;;放过特殊情况
12.     ;;2007-01-25修改为在说明中找指定文字
13.     (if (vl-string-search
14.    "SPECIAL TEXTSTYLE"
15.    (if (cdr (assoc 4 ENTSB))
16.      (cdr (assoc 4 ENTSB))
17.      ""
18.    )
19.         )
20.       (setq LOOP NIL)
21.       (progn
22.         ;;如果是属性块,ENT，如果不是，ENTB
23.         (if (assoc 66 ENTS)
24.    (setq ENT (entnext ENT))
25.    (setq ENT (entnext ENTB))
26.         )
27.         (setq LOOP t)
28.       )
29.     )
30.     ;;以下处理INSERT中的属性文字
31.     ;;取得块的插入点
32.     ;;进入块中图元的循环
33.     (while
34.       (and ENT LOOP)
35.        (setq ELIST (entget ENT))
36.        ;;以下开始处理
37.        (if (or (= (cdr (assoc 0 ELIST)) "TEXT")
38.         (= (cdr (assoc 0 ELIST)) "ATTRIB")
39.     )
40.   ;;以下IF语句是2007-1-16加入的，对字体是SM的情况加以减化
41.   (if (/= (cdr (assoc 7 ELIST)) "SM")
42.     ;;如果图元是TEXT或ATTRIB，进行以下处理
43.     (progn
44.       (setq TXB (textbox ELIST))
45.       ;;得到旧的文字总宽度
46.       (setq
47.         OLD_WIDTH (- (car (cadr TXB)) (car (car TXB)))
48.       )
49.       ;;得到旧的文字总宽度
50.       (setq ELIST
51.       (subst (cons 7 "SM") (assoc 7 ELIST) ELIST)
52.       )
53.       (setq ELIST (subst (cons 41 0.7)
54.            (assoc 41 ELIST)
55.            ELIST
56.     )
57.       )
58.       (entmod ELIST)
59.       (entmod ENTS)
60.       (setq TXB (textbox ELIST))
61.       ;;得到文字宽度
62.       (setq
63.         NEW_WIDTH (- (car (cadr TXB)) (car (car TXB)))
64.       )
65.       ;;如果新的文字宽度比旧的文字宽度宽，则对文字宽度进行修改
66.       (if (> NEW_WIDTH OLD_WIDTH)
67.         (setq ELIST
68.         (subst (cons 41 (* 0.7 (/ OLD_WIDTH NEW_WIDTH)))
69.         (assoc 41 ELIST)
70.         ELIST
71.         )
72.         )
73.       )
74.     )
75.     ;;如果字体是SM，保证其宽度比例不能超过0.7
76.     (if (> (cdr (assoc 41 ELIST)) 0.7)
77.       (setq ELIST
78.       (subst (cons 41 0.7) (assoc 41 ELIST) ELIST)
79.       )
80.     )
81.   )
82.        )
83.        (entmod ELIST)
84.        (setq ENT (entnext ENT))
85.        (if ENT
86.   (if (= (cdr (assoc 0 (entget ENT))) "SEQEND")
87.     (setq LOOP NIL)
88.   )
89.        )
90.     )
91.     (if (not (assoc 66 ENTS))
92.       (entmod ENTSB)
93.     )
94.     (entmod ENTS)
95.    )

((= (cdr (assoc 0 ENTS)) "INSERT")     (setq J (+ J 1))     (princ (strcat "\n正在处理第<"      (itoa (+ J 1))      ">个图元，请稍候..."     )     )     (setq ENTB (tblobjname "block" (cdr (assoc 2 ENTS))))     (setq ENTSB (entget ENTB))     ;;放过特殊情况     ;;2007-01-25修改为在说明中找指定文字     (if (vl-string-search    "SPECIAL TEXTSTYLE"    (if (cdr (assoc 4 ENTSB))      (cdr (assoc 4 ENTSB))      ""    )         )       (setq LOOP NIL)       (progn         ;;如果是属性块,ENT，如果不是，ENTB         (if (assoc 66 ENTS)    (setq ENT (entnext ENT))    (setq ENT (entnext ENTB))         )         (setq LOOP t)       )     )     ;;以下处理INSERT中的属性文字     ;;取得块的插入点     ;;进入块中图元的循环     (while       (and ENT LOOP)        (setq ELIST (entget ENT))        ;;以下开始处理        (if (or (= (cdr (assoc 0 ELIST)) "TEXT")         (= (cdr (assoc 0 ELIST)) "ATTRIB")     )   ;;以下IF语句是2007-1-16加入的，对字体是SM的情况加以减化   (if (/= (cdr (assoc 7 ELIST)) "SM")     ;;如果图元是TEXT或ATTRIB，进行以下处理     (progn       (setq TXB (textbox ELIST))       ;;得到旧的文字总宽度       (setq         OLD_WIDTH (- (car (cadr TXB)) (car (car TXB)))       )       ;;得到旧的文字总宽度       (setq ELIST       (subst (cons 7 "SM") (assoc 7 ELIST) ELIST)       )       (setq ELIST (subst (cons 41 0.7)            (assoc 41 ELIST)            ELIST     )       )       (entmod ELIST)       (entmod ENTS)       (setq TXB (textbox ELIST))       ;;得到文字宽度       (setq         NEW_WIDTH (- (car (cadr TXB)) (car (car TXB)))       )       ;;如果新的文字宽度比旧的文字宽度宽，则对文字宽度进行修改       (if (> NEW_WIDTH OLD_WIDTH)         (setq ELIST         (subst (cons 41 (* 0.7 (/ OLD_WIDTH NEW_WIDTH)))         (assoc 41 ELIST)         ELIST         )         )       )     )     ;;如果字体是SM，保证其宽度比例不能超过0.7     (if (> (cdr (assoc 41 ELIST)) 0.7)       (setq ELIST       (subst (cons 41 0.7) (assoc 41 ELIST) ELIST)       )     )   )        )        (entmod ELIST)        (setq ENT (entnext ENT))        (if ENT   (if (= (cdr (assoc 0 (entget ENT))) "SEQEND")     (setq LOOP NIL)   )        )     )     (if (not (assoc 66 ENTS))       (entmod ENTSB)     )     (entmod ENTS)    )

鬼魔

不是很懂这个。。。

na

龙龙仔

2. ;;求批量屬性文字轉文字
3. ;;就是還沒定義塊前的屬性文字
4. ;;By LUCAS
5. (defun C:CH_ATTDEF_TXT (/ LST N SS X)
6.   (prompt "\nSelect "Attdef" Objects: ")
7.   (if (setq SS (ssget '((0 . "ATTDEF"))))
8.     (progn
9.       (setq N 0)
10.       (repeat (sslength SS)
11. (setq LST '((0 . "TEXT")))
12. (mapcar
13.    '(lambda (X)
14.       (if (not (member (car X) '(-1 2 0 330 5 1 3 70 74 100)))
15.         (setq LST (cons X LST))
16.         (if (= (car X) 2)
17.    (setq LST (cons (cons 1 (cdr X)) LST))
18.         )
19.       )
20.     )
21.    (entget (ssname SS N))
22. )
23. (setq LST (reverse LST)
24.        N   (1+ N)
25. )
26. (entmake LST)
27.       )
28.       (command "_.erase" SS "")
29.     )
30.   )
31.   (princ)
32. )
33. (princ "\nType Ch_Attdef_Txt,By Lucas\n")
34. (princ)

;;求批量屬性文字轉文字 ;;就是還沒定義塊前的屬性文字 ;;By LUCAS (defun C:CH_ATTDEF_TXT (/ LST N SS X)   (prompt "\nSelect "Attdef" Objects: ")   (if (setq SS (ssget '((0 . "ATTDEF"))))     (progn       (setq N 0)       (repeat (sslength SS) (setq LST '((0 . "TEXT"))) (mapcar    '(lambda (X)       (if (not (member (car X) '(-1 2 0 330 5 1 3 70 74 100)))         (setq LST (cons X LST))         (if (= (car X) 2)    (setq LST (cons (cons 1 (cdr X)) LST))         )       )     )    (entget (ssname SS N)) ) (setq LST (reverse LST)        N   (1+ N) ) (entmake LST)       )       (command "_.erase" SS "")     )   )   (princ) ) (princ "\nType Ch_Attdef_Txt,By Lucas\n") (princ)

无痕

06年以前好像也写过，这个是在我电脑上找到的，不象是我自己写的

2. ;; 属性转文本　
3. (defun C:TAG2TXT ()
4.   (setq sset (ssget '((0 . "ATTDEF"))))
5.   (setq num (sslength sset) itm 0)
6.   (while (< itm num)
7.     (setq hnd (ssname sset itm))
8.     (setq ent (entget hnd))
9.     (setq new '((0 . "TEXT")))
10.     (setq new (append new (list (cons 1 (cdr (assoc 2 ent))))))
11.     (setq dolst (list 7 8 10 11 39 40 41 50 51 62 71 72 73))
12.     (foreach grp dolst
13.       (setq addto (assoc grp ent))
14.       (if (/= addto nil)
15.         (setq new (append new (list (assoc grp ent))))
16.       )
17.     )
18.     (entdel hnd)
19.     (entmake new)
20.     (setq itm (1+ itm))
21.   )
22.   (princ)
23. )

;; 属性转文本　 (defun C:TAG2TXT ()   (setq sset (ssget '((0 . "ATTDEF"))))   (setq num (sslength sset) itm 0)   (while (< itm num)     (setq hnd (ssname sset itm))     (setq ent (entget hnd))     (setq new '((0 . "TEXT")))     (setq new (append new (list (cons 1 (cdr (assoc 2 ent))))))     (setq dolst (list 7 8 10 11 39 40 41 50 51 62 71 72 73))     (foreach grp dolst       (setq addto (assoc grp ent))       (if (/= addto nil)         (setq new (append new (list (assoc grp ent))))       )     )     (entdel hnd)     (entmake new)     (setq itm (1+ itm))   )   (princ) )

鬼魔

谢谢楼上的2位朋友,这程序解决了大忙了

tcsl9621

用CAD扩展工具好了。那里就有。

鬼魔

回楼上的

那个是定义块后的  

剧毒噬骨

我是来求工具的 ，我也需要这个，还没学习好 代码怎么用呀