求高手帮忙看看代码，可能是textbox的问题，也可能是entmod的问题

tranney

我是设备专业的，经常从建筑调图，发现每个人的图名样式都不一样，所以一张图里面有很多种图名样式，前几天看到有人发的代码，我也根据我的需要修改了一下，谁知道，有点问题，请大伙帮我看看，先谢谢了

2. ;;;;;;***************************文本加双下划线
   
3. (defun c:fe (/   sc  box   ent   ent1  h     nent1 nent2 np1 np2
   
4.        np3 np4 np5   old_lay     p     p1x   p1y   p2x   p2y
   
5.        px     py   r    snap  test
   
6.       )
   
7.   (if (= (tblsearch "style" "菜菜字体") nil)
   
8.     (command "_.style" "菜菜字体"  "txt,hztxt" "0"  ".7" ""  "" "" "")
   
9.   )
   
10.     (if (null sc)
    
11.     (SETQ sc  (GETVAR "DIMSCALE")))
    
12.   (setq ent1 (car (entsel "\n选择文本：")))
    
13.   (setvar "cmdecho" 0)
    
14. ;;;; 关闭命令响应
    
15.   (command ".UNDO" "BE")    ; 设置undo起点
    
16.   (setq snap (getvar "osmode"))
    
17.   (setvar "osmode" 0)
    
18. ;;;; 关闭捕捉
    
19.   (setq old_lay (getvar "clayer"))  ; 保存当前图层
    
20.   (setq ent (entget ent1))
    
21.   (if (= "MTEXT" (cdr (assoc 0 ent)))  ; 如选多行文本，则转化为单行文本
    
22.     (progn
    
23.       (command ".EXPLODE" ent1)
    
24.       (setq ent1 (entlast))
    
25.       (setq ent (entget ent1))
    
26.     )
    
27.     (princ)
    
28.   )
    
29.   
    
30.   (entmod (list  (assoc -1 ent)
    
31.     (cons 7 "菜菜字体")
    
32.     (cons 8 "0-标题文字")
    
33.     (cons 40 600)
    
34.     (cons 41 0.8)
    
35.     ;(cons 50 0)
    
36.     (cons 62 7)
    
37.     (cons 370 5)
    
38.     )
    
39.   )
    
40. ;关键获取不了更新的图元参数
    
41. 
    
42.   (setq  p    (cdr (assoc 10 ent))  ; 文本基点坐标
    
43.       r    (cdr (assoc 50 ent))  ; 文本旋转角度
    
44.       test (cdr (assoc 8 ent))  ; 文本所在图层
    
45.   )
    
46. 
    
47.   (setq box (textbox ent))    ; 文本框坐标
    
48.   (setq  p1x (car (car box))    ; 文本左下角X坐标
    
49.   p1y (car (cdr (car box)))
    
50.   p2x (car (car (cdr box)))  ; 文本右上角X坐标
    
51.   p2y (car (cdr (car (cdr box))))
    
52.   px  (car p)
    
53.   py  (car (cdr p))
    
54.   )
    
55. 
    
56. ;;;第一条线段左端点坐标
    
57.   (setq np1 (list (- px (* sc 0.8)) (- py (* sc 1.5)) 0.0))
    
58. ;;;第一条线段右端点坐标
    
59.   (setq np2 (list (+ p2x (+ px (* sc 0.8))) (- py (* sc 1.5)) 0.0))
    
60. ;;;; 第二条线段左端点坐标
    
61.   (setq np3 (list (- px (* sc 0.8)) (- py (* sc 2.5)) 0.0))
    
62. ;;;; 第二条线段右端点坐标
    
63.   (setq np4 (list (+ p2x (+ px (* sc 0.8))) (- py (* sc 2.5)) 0.0))
    
64. ;;;; 第一条线段右端点坐标偏移一点点写比例
    
65.   (setq np5 (list (+ p2x (+ px (* sc 2.8))) (- py (* sc 1.5)) 0.0))
    
66.   (SETVAR "CLAYER" test)    ; 文本所在图层设为当前图层
    
67.   (command "pline" np1 "w" (* sc 0.8) (* sc 0.8) np2 "")
    
68.   (setq nent1 (entlast))
    
69.   (command "text" "s" "菜菜字体" "J" "BL" np5 "400" 0 "1:100")
    
70.   (setq nent3 (entlast))
    
71.   (command "line" np3 np4 "")    ; 第二条下划线
    
72.   (setq nent2 (entlast))
    
73.   (if (/= r 0.0)
    
74. ;;;; 如果文本不水平则旋转下划线角度
    
75.     (progn
    
76.       (command "rotate" nent1 "" p (* 180.0 (/ r pi)))
    
77.       (command "rotate" nent2 "" p (* 180.0 (/ r pi)))
    
78.       (command "rotate" nent3 "" p (* 180.0 (/ r pi)))
    
79.     )
    
80.   )
    
81.   (setvar "osmode" snap)
    
82.   (setvar "clayer" old_lay)    ; 恢复当前图层
    
83.   (command ".UNDO" "E")
    
84.   (princ)
    
85. )

;;;;;;***************************文本加双下划线<br /> (defun c:fe (/   sc  box   ent   ent1  h     nent1 nent2 np1 np2<br />        np3 np4 np5   old_lay     p     p1x   p1y   p2x   p2y<br />        px     py   r    snap  test<br />       )<br />   (if (= (tblsearch "style" "菜菜字体") nil)<br />     (command "_.style" "菜菜字体"  "txt,hztxt" "0"  ".7" ""  "" "" "")<br />   )<br />     (if (null sc)<br />     (SETQ sc  (GETVAR "DIMSCALE")))<br />   (setq ent1 (car (entsel "\n选择文本：")))<br />   (setvar "cmdecho" 0)<br /> ;;;; 关闭命令响应<br />   (command ".UNDO" "BE")    ; 设置undo起点<br />   (setq snap (getvar "osmode"))<br />   (setvar "osmode" 0)<br /> ;;;; 关闭捕捉<br />   (setq old_lay (getvar "clayer"))  ; 保存当前图层<br />   (setq ent (entget ent1))<br />   (if (= "MTEXT" (cdr (assoc 0 ent)))  ; 如选多行文本，则转化为单行文本<br />     (progn<br />       (command ".EXPLODE" ent1)<br />       (setq ent1 (entlast))<br />       (setq ent (entget ent1))<br />     )<br />     (princ)<br />   )<br />   <br />   (entmod (list  (assoc -1 ent)<br />     (cons 7 "菜菜字体")<br />     (cons 8 "0-标题文字")<br />     (cons 40 600)<br />     (cons 41 0.8)<br />     ;(cons 50 0)<br />     (cons 62 7)<br />     (cons 370 5)<br />     )<br />   )<br /> ;关键获取不了更新的图元参数<br /> <br />   (setq  p    (cdr (assoc 10 ent))  ; 文本基点坐标<br />       r    (cdr (assoc 50 ent))  ; 文本旋转角度<br />       test (cdr (assoc 8 ent))  ; 文本所在图层<br />   )<br /> <br />   (setq box (textbox ent))    ; 文本框坐标<br />   (setq  p1x (car (car box))    ; 文本左下角X坐标<br />   p1y (car (cdr (car box)))<br />   p2x (car (car (cdr box)))  ; 文本右上角X坐标<br />   p2y (car (cdr (car (cdr box))))<br />   px  (car p)<br />   py  (car (cdr p))<br />   )<br /> <br /> ;;;第一条线段左端点坐标<br />   (setq np1 (list (- px (* sc 0.8)) (- py (* sc 1.5)) 0.0))<br /> ;;;第一条线段右端点坐标<br />   (setq np2 (list (+ p2x (+ px (* sc 0.8))) (- py (* sc 1.5)) 0.0))<br /> ;;;; 第二条线段左端点坐标<br />   (setq np3 (list (- px (* sc 0.8)) (- py (* sc 2.5)) 0.0))<br /> ;;;; 第二条线段右端点坐标<br />   (setq np4 (list (+ p2x (+ px (* sc 0.8))) (- py (* sc 2.5)) 0.0))<br /> ;;;; 第一条线段右端点坐标偏移一点点写比例<br />   (setq np5 (list (+ p2x (+ px (* sc 2.8))) (- py (* sc 1.5)) 0.0))<br />   (SETVAR "CLAYER" test)    ; 文本所在图层设为当前图层<br />   (command "pline" np1 "w" (* sc 0.8) (* sc 0.8) np2 "")<br />   (setq nent1 (entlast))<br />   (command "text" "s" "菜菜字体" "J" "BL" np5 "400" 0 "1:100")<br />   (setq nent3 (entlast))<br />   (command "line" np3 np4 "")    ; 第二条下划线<br />   (setq nent2 (entlast))<br />   (if (/= r 0.0)<br /> ;;;; 如果文本不水平则旋转下划线角度<br />     (progn<br />       (command "rotate" nent1 "" p (* 180.0 (/ r pi)))<br />       (command "rotate" nent2 "" p (* 180.0 (/ r pi)))<br />       (command "rotate" nent3 "" p (* 180.0 (/ r pi)))<br />     )<br />   )<br />   (setvar "osmode" snap)<br />   (setvar "clayer" old_lay)    ; 恢复当前图层<br />   (command ".UNDO" "E")<br />   (princ)<br /> )

ZZXXQQ

2. ;;;;;;***************************文本加双下划线
   
3. (defun c:fe (/   sc  box   ent   ent1  h     nent1 nent2 np1 np2
   
4.        np3 np4 np5   old_lay     p     p1x   p1y   p2x   p2y
   
5.        px     py   r    snap  test
   
6.       )
   
7.   (setvar "CMDECHO" 0)
   
8. ;;;; 关闭命令响应
   
9.   (command ".UNDO" "BE")    ; 设置undo起点
   
10.   (setq snap (getvar "OSMODE"))
    
11.   (setvar "OSMODE" 0)
    
12. ;;;; 关闭捕捉
    
13.   (setq old_lay (getvar "clayer"))  ; 保存当前图层
    
14.   (if (= (tblsearch "style" "菜菜字体") nil)
    
15.     (command "_.style" "菜菜字体"  "txt,hztxt" "0"  ".7" ""  "" "" "")
    
16.   )
    
17.   (if (null sc) (setq sc  (getvar "DIMSCALE")))
    
18.   (setq ent1 (car (entsel "\n选择文本：")))
    
19.   (setq ent (entget ent1))
    
20.   (if (= "MTEXT" (cdr (assoc 0 ent))) (progn  ; 如选多行文本，则转化为单行文本
    
21.     (command ".EXPLODE" ent1)
    
22.     (setq ent1 (entlast))
    
23.     (setq ent (entget ent1))
    
24.   ))
    
25.   (setq ent (subst (cons 7 "菜菜字体") (assoc 7 ent) ent))
    
26.   (setq ent (subst (cons 8 "0-标题文字") (assoc 8 ent) ent))
    
27.   (setq ent (subst (cons 40 600) (assoc 40 ent) ent))
    
28.   (setq ent (subst (cons 41 0.8) (assoc 41 ent) ent))
    
29.   (if (assoc 62 ent)
    
30.    (setq ent (subst (cons 62 7) (assoc 62 ent) ent))
    
31.    (setq ent (append ent (list(cons 62 7))))
    
32.   )
    
33.   (entmod (subst (cons 370 5) (assoc 370 ent) ent))
    
34. ;关键获取不了更新的图元参数
    
35.   (setq  p    (cdr (assoc 10 ent))  ; 文本基点坐标
    
36.       r    (cdr (assoc 50 ent))  ; 文本旋转角度
    
37.       test (cdr (assoc 8 ent))  ; 文本所在图层
    
38.   )
    
39.   (setq box (textbox ent))    ; 文本框坐标
    
40.   (setq  p1x (caar box)    ; 文本左下角X坐标
    
41.   p1y (cadar box)
    
42.   p2x (caadr box)  ; 文本右上角X坐标
    
43.   p2y (cadadr box)
    
44.   px  (car p)
    
45.   py  (cadr p))
    
46. ;;;第一条线段左端点坐标
    
47.   (setq np1 (list (- px (* sc 0.8)) (- py (* sc 1.5)) 0.0))
    
48. ;;;第一条线段右端点坐标
    
49.   (setq np2 (list (+ p2x (+ px (* sc 0.8))) (- py (* sc 1.5)) 0.0))
    
50. ;;;; 第二条线段左端点坐标
    
51.   (setq np3 (list (- px (* sc 0.8)) (- py (* sc 2.5)) 0.0))
    
52. ;;;; 第二条线段右端点坐标
    
53.   (setq np4 (list (+ p2x (+ px (* sc 0.8))) (- py (* sc 2.5)) 0.0))
    
54. ;;;; 第一条线段右端点坐标偏移一点点写比例
    
55.   (setq np5 (list (+ p2x (+ px (* sc 2.8))) (- py (* sc 1.5)) 0.0))
    
56.   (setvar "CLAYER" test)    ; 文本所在图层设为当前图层
    
57.   (command "pline" np1 "w" (* sc 0.8) (* sc 0.8) np2 "")
    
58.   (setq nent1 (entlast))
    
59.   (command "text" "s" "菜菜字体" "BL" np5 "400" 0 "1:100")
    
60.   (setq nent3 (entlast))
    
61.   (command "line" np3 np4 "")    ; 第二条下划线
    
62.   (setq nent2 (entlast))
    
63.   (if (/= r 0.0) ;;;; 如果文本不水平则旋转下划线角度
    
64.     (command "rotate" nent1 nent2 nent3 "" p (/ (* r 180.0) pi))
    
65.   )
    
66.   (setvar "OSMODE" snap)
    
67.   (setvar "CLAYER" old_lay)    ; 恢复当前图层
    
68.   (command ".UNDO" "E")
    
69.   (princ)
    
70. )

;;;;;;***************************文本加双下划线<br /> (defun c:fe (/   sc  box   ent   ent1  h     nent1 nent2 np1 np2<br />        np3 np4 np5   old_lay     p     p1x   p1y   p2x   p2y<br />        px     py   r    snap  test<br />       )<br />   (setvar "CMDECHO" 0)<br /> ;;;; 关闭命令响应<br />   (command ".UNDO" "BE")    ; 设置undo起点<br />   (setq snap (getvar "OSMODE"))<br />   (setvar "OSMODE" 0)<br /> ;;;; 关闭捕捉<br />   (setq old_lay (getvar "clayer"))  ; 保存当前图层<br />   (if (= (tblsearch "style" "菜菜字体") nil)<br />     (command "_.style" "菜菜字体"  "txt,hztxt" "0"  ".7" ""  "" "" "")<br />   )<br />   (if (null sc) (setq sc  (getvar "DIMSCALE")))<br />   (setq ent1 (car (entsel "\n选择文本：")))<br />   (setq ent (entget ent1))<br />   (if (= "MTEXT" (cdr (assoc 0 ent))) (progn  ; 如选多行文本，则转化为单行文本<br />     (command ".EXPLODE" ent1)<br />     (setq ent1 (entlast))<br />     (setq ent (entget ent1))<br />   ))<br />   (setq ent (subst (cons 7 "菜菜字体") (assoc 7 ent) ent))<br />   (setq ent (subst (cons 8 "0-标题文字") (assoc 8 ent) ent))<br />   (setq ent (subst (cons 40 600) (assoc 40 ent) ent))<br />   (setq ent (subst (cons 41 0.8) (assoc 41 ent) ent))<br />   (if (assoc 62 ent)<br />    (setq ent (subst (cons 62 7) (assoc 62 ent) ent))<br />    (setq ent (append ent (list(cons 62 7))))<br />   )<br />   (entmod (subst (cons 370 5) (assoc 370 ent) ent))<br /> ;关键获取不了更新的图元参数<br />   (setq  p    (cdr (assoc 10 ent))  ; 文本基点坐标<br />       r    (cdr (assoc 50 ent))  ; 文本旋转角度<br />       test (cdr (assoc 8 ent))  ; 文本所在图层<br />   )<br />   (setq box (textbox ent))    ; 文本框坐标<br />   (setq  p1x (caar box)    ; 文本左下角X坐标<br />   p1y (cadar box)<br />   p2x (caadr box)  ; 文本右上角X坐标<br />   p2y (cadadr box)<br />   px  (car p)<br />   py  (cadr p))<br /> ;;;第一条线段左端点坐标<br />   (setq np1 (list (- px (* sc 0.8)) (- py (* sc 1.5)) 0.0))<br /> ;;;第一条线段右端点坐标<br />   (setq np2 (list (+ p2x (+ px (* sc 0.8))) (- py (* sc 1.5)) 0.0))<br /> ;;;; 第二条线段左端点坐标<br />   (setq np3 (list (- px (* sc 0.8)) (- py (* sc 2.5)) 0.0))<br /> ;;;; 第二条线段右端点坐标<br />   (setq np4 (list (+ p2x (+ px (* sc 0.8))) (- py (* sc 2.5)) 0.0))<br /> ;;;; 第一条线段右端点坐标偏移一点点写比例<br />   (setq np5 (list (+ p2x (+ px (* sc 2.8))) (- py (* sc 1.5)) 0.0))<br />   (setvar "CLAYER" test)    ; 文本所在图层设为当前图层<br />   (command "pline" np1 "w" (* sc 0.8) (* sc 0.8) np2 "")<br />   (setq nent1 (entlast))<br />   (command "text" "s" "菜菜字体" "BL" np5 "400" 0 "1:100")<br />   (setq nent3 (entlast))<br />   (command "line" np3 np4 "")    ; 第二条下划线<br />   (setq nent2 (entlast))<br />   (if (/= r 0.0) ;;;; 如果文本不水平则旋转下划线角度<br />     (command "rotate" nent1 nent2 nent3 "" p (/ (* r 180.0) pi))<br />   )<br />   (setvar "OSMODE" snap)<br />   (setvar "CLAYER" old_lay)    ; 恢复当前图层<br />   (command ".UNDO" "E")<br />   (princ)<br /> )

tranney

谢谢z超级版主，我昨天弄了一夜都没弄好呢，哈哈，真的非常感谢，你起得真早啊