字符下划线随字符长短变化

帝都划水王

字符下划线随着字符修改的长短变化而变化，始终比字符两段长100，如何实现

cghdy

e2002  2024-1-19 09:13
У

...

画图越规范，超作越批量。

e2002

实际工作中，还是关注设计本身吧，不需要纠结这种细微末节。

毕竟一张要打印的图纸上，除了大样图这种，其他基本上涉及到图名的位置不超过5处，你就手动改一下也不需要多少时间。

有这个精力，不如用在画图的符合企业规范、绘制中的精确度，标注与说明文字的的准确性上。

尘缘一生

三领强大的综合修剪之中，一小功能罢了。

x_s_s_1

胡编乱造小bug版

1. (vl-load-com)
   
2. (if (not *bl*)
   
3.     (setq *bl* "1:100"))
   
4. (if (or  (= (getvar "userr1") "")
   
5.   (= (equal (getvar "userr1") 0)))
   
6.     (setvar "userr1" 100))
   
7. (defun ly_mak  (l_p l_l l_c l_s l_n /)
   
8.     (if  (= (tblobjname "LAYER" l_n) nil)
   
9.   (progn (entmake  (list (cons 0 "LAYER")
   
10.             (cons 100 "AcDbSymbolTableRecord")
    
11.             (cons 100 "AcDbLayerTableRecord")
    
12.             (if l_p
    
13.           (cons 290 l_p)
    
14.           '(290 . 1))
    
15.             (if l_l
    
16.           (cons 6 l_l)
    
17.           '(6 . "CONTINUOUS"))
    
18.             (if l_c
    
19.           (cons 62 l_c)
    
20.           '(62 . 7))
    
21.             (if l_s
    
22.           (cons 70 l_s)
    
23.           '(70 . 0))
    
24.             (cons 2 l_n))))))
    
25. (defun t_mak  (l_n t_10 t_11 t_t t_50 t_72 t_73 t_h t_w t_st /)
    
26.     (entmake (list '(0 . "text")
    
27.        '(100 . "AcDbEntity")
    
28.        (cons 8 l_n)
    
29.        '(100 . "AcDbText")
    
30.        (cons 10 t_10)
    
31.        (cons 1 t_t)
    
32.        (cons 40 t_h)
    
33.        (cons 41 t_w)
    
34.        (cons 7 t_st)
    
35.        (cons 72 t_72)
    
36.        (cons 11 t_11)
    
37.        (cons 50 t_50)
    
38.        (cons 73 t_73))))
    
39. (defun pl_mak  (lst l_n w / x)
    
40.     (entmake (append (list '(0 . "LWPOLYLINE")
    
41.          '(100 . "AcDbEntity")
    
42.          '(100 . "AcDbPolyline")
    
43.          (cons 8 l_n)
    
44.          (cons 90 (length lst))
    
45.          (cons 43 w))
    
46.          (mapcar '(lambda (x) (cons 10 x)) lst))))
    
47. (defun del_z  (pt /)
    
48.     (reverse (cdr (reverse pt))))
    
49. (defun x_text_by_line_change  (change-obj     reactor-obj
    
50.              parameter-list     /       pt1
    
51.              tm_txt   sc     txt_obj   ptl
    
52.              pta   ptb     ptc       pl_obj
    
53.              lst   oldlst     i       x
    
54.              bl_obj)
    
55.     (if  (setq txt_obj (vlax-vla-object->ename change-obj))
    
56.   (progn
    
57.       (setq pl_obj (handent (car (vlr-data reactor-obj))))
    
58.       (setq bl_obj (handent (cadr (vlr-data reactor-obj))))
    
59.       (setq sc (getvar "userr1"))
    
60.       (setq ptl (textbox (entget txt_obj)))
    
61.       (setq pt1 (cdr (assoc 11 (entget txt_obj))))
    
62.       (setq ptl (mapcar '- (cadr ptl) (car ptl)))
    
63.       (setq pta (polar pt1 pi (+ (/ (car ptl) 2) (* 1.5 sc))))
    
64.       (setq pta (polar pta (* 1.5 pi) (* 1.5 sc)))
    
65.       (setq ptb (polar pt1 0 (+ (/ (car ptl) 2) (* 1.5 sc))))
    
66.       (setq ptb (polar ptb (* 1.5 pi) (* 1.5 sc)))
    
67.       (setq ptc (polar (polar ptb (* 0.5 pi) (* 1.5 sc)) 0 sc))
    
68.       (setq ptl (mapcar '(lambda (x) (cons 10 (del_z x)))
    
69.             (list pta ptb)))
    
70.       (setq lst (entget pl_obj))
    
71.       (setq oldlst
    
72.          (apply 'append
    
73.           (mapcar '(lambda (x)
    
74.            (if (= 10 (car x))
    
75.                (list x)))
    
76.             lst)))
    
77.       (setq i 0)
    
78.       (repeat (length ptl)
    
79.     (setq lst (subst (nth i ptl) (nth i oldlst) lst))
    
80.     (setq i (1+ i)))
    
81.       (entmod lst)
    
82.       (setq lst (entget bl_obj))
    
83.       (setq lst (subst (cons 10 ptc) (assoc 10 lst) lst))
    
84.       (entmod lst))))
    
85. (DEFUN creat_objreactor   (obj obj_lst /)
    
86.     (vlr-pers (vlr-object-reactor
    
87.       obj
    
88.       obj_lst
    
89.       '((:vlr-modified . x_text_by_line_change)
    
90.         (:vlr-copied . x_text_by_line_copied)
    
91.         (:VLR-ERASED . AR_AE_RR_ERASED)))))
    
92. (DEFUN x_text_by_line_copied
    
93.        (NOTIFIER-OBJECT REACTOR-OBJECT PARAMETER-LIST / ENT)
    
94.     (IF  (/= (CAR PARAMETER-LIST) 0)
    
95.   (SETQ ENT      (CAR PARAMETER-LIST)
    
96.         *REACTORCOPY* (CONS ENT *REACTORCOPY*))))
    
97. (DEFUN CMD-START  (REACTOR COMMAND-LIST /)
    
98.     (SETQ *REACTORCOPY* NIL)
    
99.     (PRINC))
    
100. (DEFUN CMD-ENDED  (REACTOR  COMMAND-LIST      /         ent
     
101.        txt_obj  ptl       pt1      pta      ptb
     
102.        ptc      sc       pl_obj   bl_obj)
     
103.     (IF  *REACTORCOPY*
     
104.   (FOREACH ent  *REACTORCOPY*
     
105.       (SETQ txt_obj (cons (VLAX-ENAME->VLA-OBJECT ent) nil))
     
106.       (setq sc (getvar "userr1"))
     
107.       (setq ptl (textbox (entget ent)))
     
108.       (setq pt1 (cdr (assoc 11 (entget ent))))
     
109.       (setq ptl (mapcar '- (cadr ptl) (car ptl)))
     
110.       (setq pta (polar pt1 pi (+ (/ (car ptl) 2) (* 1.5 sc))))
     
111.       (setq pta (polar pta (* 1.5 pi) (* 1.5 sc)))
     
112.       (setq ptb (polar pt1 0 (+ (/ (car ptl) 2) (* 1.5 sc))))
     
113.       (setq ptb (polar ptb (* 1.5 pi) (* 1.5 sc)))
     
114.       (setq ptl (list pta ptb))
     
115.       (pl_mak ptl "图名" (* 0.5 sc))
     
116.       (setq pl_obj (cdr (assoc 5 (entget (entlast)))))
     
117.       (setq ptc (polar (polar ptb (* 0.5 pi) (* 1.5 sc)) 0 sc))
     
118.       (t_mak "图名"
     
119.        ptc
     
120.        ptc
     
121.        *bl*
     
122.        0
     
123.        0
     
124.        0
     
125.        (* 4 sc)
     
126.        0.75
     
127.        "standard")
     
128.       (setq bl_obj (cdr (assoc 5 (entget (entlast)))))
     
129.       (creat_objreactor txt_obj (list pl_obj bl_obj))))
     
130.     (SETQ *REACTORCOPY* NIL)
     
131.     (PRINC))
     
132. (DEFUN AR_AE_RR_ERASED
     
133.        (NOTIFIER-OBJECT REACTOR-OBJECT PARAMETER-LIST / I)
     
134.     (FOREACH I  (CDR (CAR (VLR-REACTORS :VLR-OBJECT-REACTOR)))
     
135.   (IF (VLAX-ERASED-P (CAR (VLR-OWNERS I)))
     
136.       (PROGN (VLR-PERS-RELEASE I) (VLR-REMOVE I)))))
     
137. (defun c:xx  (/  pt1 tm_txt sc txt_obj ptl pta ptb ptc pl_obj x_vlr
     
138.         bl_obj scc)
     
139.     (ly_mak 1 "continuous" 7 0 "图名")
     
140.     (setq pt1   (getpoint "\n请输入图名插入点：")
     
141.     tm_txt (getstring "\n请输入图名：")
     
142.     sc   (getvar "userr1"))
     
143.     (setq scc (getstring "\n请输入比例：(1:?) <100>"))
     
144.     (IF  (= scc "")
     
145.   (SETQ scc "100"))
     
146.     (setq *bl* (strcat "1:" scc))
     
147.     (t_mak "图名"
     
148.      '(0 0 0)
     
149.      pt1
     
150.      tm_txt
     
151.      0
     
152.      1
     
153.      0
     
154.      (* 7 sc)
     
155.      0.75
     
156.      "standard")
     
157.     (setq txt_obj (cons (vlax-ename->vla-object (entlast)) nil))
     
158.     (setq ptl (textbox (entget (entlast))))
     
159.     (setq ptl (mapcar '- (cadr ptl) (car ptl)))
     
160.     (setq pta (polar pt1 pi (+ (/ (car ptl) 2) (* 1.5 sc))))
     
161.     (setq pta (polar pta (* 1.5 pi) (* 1.5 sc)))
     
162.     (setq ptb (polar pt1 0 (+ (/ (car ptl) 2) (* 1.5 sc))))
     
163.     (setq ptb (polar ptb (* 1.5 pi) (* 1.5 sc)))
     
164.     (setq ptl (list pta ptb))
     
165.     (pl_mak ptl "图名" (* 0.5 sc))
     
166.     (setq pl_obj (cdr (assoc 5 (entget (entlast)))))
     
167.     (setq ptc (polar (polar ptb (* 0.5 pi) (* 1.5 sc)) 0 sc))
     
168.     (t_mak "图名" ptc ptc *bl* 0 0 0 (* 4 sc) 0.75 "standard")
     
169.     (setq bl_obj (cdr (assoc 5 (entget (entlast)))))
     
170.     (creat_objreactor txt_obj (list pl_obj bl_obj))
     
171.     (IF  (NOT *COMMANDREACTOR*)
     
172.   (SETQ *COMMANDREACTOR*
     
173.      (VLR-PERS (VLR-COMMAND-REACTOR
     
174.              NIL
     
175.              '((:VLR-COMMANDWILLSTART
     
176.           .
     
177.           CMD-START)
     
178.          (:VLR-COMMANDENDED
     
179.           .
     
180.           CMD-ENDED)))))))
     
181. 
     

(vl-load-com)<br /> (if (not *bl*)<br />     (setq *bl* "1:100"))<br /> (if (or  (= (getvar "userr1") "")<br />   (= (equal (getvar "userr1") 0)))<br />     (setvar "userr1" 100))<br /> (defun ly_mak  (l_p l_l l_c l_s l_n /)<br />     (if  (= (tblobjname "LAYER" l_n) nil)<br />   (progn (entmake  (list (cons 0 "LAYER")<br />             (cons 100 "AcDbSymbolTableRecord")<br />             (cons 100 "AcDbLayerTableRecord")<br />             (if l_p<br />           (cons 290 l_p)<br />           '(290 . 1))<br />             (if l_l<br />           (cons 6 l_l)<br />           '(6 . "CONTINUOUS"))<br />             (if l_c<br />           (cons 62 l_c)<br />           '(62 . 7))<br />             (if l_s<br />           (cons 70 l_s)<br />           '(70 . 0))<br />             (cons 2 l_n))))))<br /> (defun t_mak  (l_n t_10 t_11 t_t t_50 t_72 t_73 t_h t_w t_st /)<br />     (entmake (list '(0 . "text")<br />        '(100 . "AcDbEntity")<br />        (cons 8 l_n)<br />        '(100 . "AcDbText")<br />        (cons 10 t_10)<br />        (cons 1 t_t)<br />        (cons 40 t_h)<br />        (cons 41 t_w)<br />        (cons 7 t_st)<br />        (cons 72 t_72)<br />        (cons 11 t_11)<br />        (cons 50 t_50)<br />        (cons 73 t_73))))<br /> (defun pl_mak  (lst l_n w / x)<br />     (entmake (append (list '(0 . "LWPOLYLINE")<br />          '(100 . "AcDbEntity")<br />          '(100 . "AcDbPolyline")<br />          (cons 8 l_n)<br />          (cons 90 (length lst))<br />          (cons 43 w))<br />          (mapcar '(lambda (x) (cons 10 x)) lst))))<br /> (defun del_z  (pt /)<br />     (reverse (cdr (reverse pt))))<br /> (defun x_text_by_line_change  (change-obj     reactor-obj<br />              parameter-list     /       pt1<br />              tm_txt   sc     txt_obj   ptl<br />              pta   ptb     ptc       pl_obj<br />              lst   oldlst     i       x<br />              bl_obj)<br />     (if  (setq txt_obj (vlax-vla-object->ename change-obj))<br />   (progn<br />       (setq pl_obj (handent (car (vlr-data reactor-obj))))<br />       (setq bl_obj (handent (cadr (vlr-data reactor-obj))))<br />       (setq sc (getvar "userr1"))<br />       (setq ptl (textbox (entget txt_obj)))<br />       (setq pt1 (cdr (assoc 11 (entget txt_obj))))<br />       (setq ptl (mapcar '- (cadr ptl) (car ptl)))<br />       (setq pta (polar pt1 pi (+ (/ (car ptl) 2) (* 1.5 sc))))<br />       (setq pta (polar pta (* 1.5 pi) (* 1.5 sc)))<br />       (setq ptb (polar pt1 0 (+ (/ (car ptl) 2) (* 1.5 sc))))<br />       (setq ptb (polar ptb (* 1.5 pi) (* 1.5 sc)))<br />       (setq ptc (polar (polar ptb (* 0.5 pi) (* 1.5 sc)) 0 sc))<br />       (setq ptl (mapcar '(lambda (x) (cons 10 (del_z x)))<br />             (list pta ptb)))<br />       (setq lst (entget pl_obj))<br />       (setq oldlst<br />          (apply 'append<br />           (mapcar '(lambda (x)<br />            (if (= 10 (car x))<br />                (list x)))<br />             lst)))<br />       (setq i 0)<br />       (repeat (length ptl)<br />     (setq lst (subst (nth i ptl) (nth i oldlst) lst))<br />     (setq i (1+ i)))<br />       (entmod lst)<br />       (setq lst (entget bl_obj))<br />       (setq lst (subst (cons 10 ptc) (assoc 10 lst) lst))<br />       (entmod lst))))<br /> (DEFUN creat_objreactor   (obj obj_lst /)<br />     (vlr-pers (vlr-object-reactor<br />       obj<br />       obj_lst<br />       '((:vlr-modified . x_text_by_line_change)<br />         (:vlr-copied . x_text_by_line_copied)<br />         (:VLR-ERASED . AR_AE_RR_ERASED)))))<br /> (DEFUN x_text_by_line_copied<br />        (NOTIFIER-OBJECT REACTOR-OBJECT PARAMETER-LIST / ENT)<br />     (IF  (/= (CAR PARAMETER-LIST) 0)<br />   (SETQ ENT      (CAR PARAMETER-LIST)<br />         *REACTORCOPY* (CONS ENT *REACTORCOPY*))))<br /> (DEFUN CMD-START  (REACTOR COMMAND-LIST /)<br />     (SETQ *REACTORCOPY* NIL)<br />     (PRINC))<br /> (DEFUN CMD-ENDED  (REACTOR  COMMAND-LIST      /         ent<br />        txt_obj  ptl       pt1      pta      ptb<br />        ptc      sc       pl_obj   bl_obj)<br />     (IF  *REACTORCOPY*<br />   (FOREACH ent  *REACTORCOPY*<br />       (SETQ txt_obj (cons (VLAX-ENAME->VLA-OBJECT ent) nil))<br />       (setq sc (getvar "userr1"))<br />       (setq ptl (textbox (entget ent)))<br />       (setq pt1 (cdr (assoc 11 (entget ent))))<br />       (setq ptl (mapcar '- (cadr ptl) (car ptl)))<br />       (setq pta (polar pt1 pi (+ (/ (car ptl) 2) (* 1.5 sc))))<br />       (setq pta (polar pta (* 1.5 pi) (* 1.5 sc)))<br />       (setq ptb (polar pt1 0 (+ (/ (car ptl) 2) (* 1.5 sc))))<br />       (setq ptb (polar ptb (* 1.5 pi) (* 1.5 sc)))<br />       (setq ptl (list pta ptb))<br />       (pl_mak ptl "图名" (* 0.5 sc))<br />       (setq pl_obj (cdr (assoc 5 (entget (entlast)))))<br />       (setq ptc (polar (polar ptb (* 0.5 pi) (* 1.5 sc)) 0 sc))<br />       (t_mak "图名"<br />        ptc<br />        ptc<br />        *bl*<br />        0<br />        0<br />        0<br />        (* 4 sc)<br />        0.75<br />        "standard")<br />       (setq bl_obj (cdr (assoc 5 (entget (entlast)))))<br />       (creat_objreactor txt_obj (list pl_obj bl_obj))))<br />     (SETQ *REACTORCOPY* NIL)<br />     (PRINC))<br /> (DEFUN AR_AE_RR_ERASED<br />        (NOTIFIER-OBJECT REACTOR-OBJECT PARAMETER-LIST / I)<br />     (FOREACH I  (CDR (CAR (VLR-REACTORS :VLR-OBJECT-REACTOR)))<br />   (IF (VLAX-ERASED-P (CAR (VLR-OWNERS I)))<br />       (PROGN (VLR-PERS-RELEASE I) (VLR-REMOVE I)))))<br /> (defun c:xx  (/  pt1 tm_txt sc txt_obj ptl pta ptb ptc pl_obj x_vlr<br />         bl_obj scc)<br />     (ly_mak 1 "continuous" 7 0 "图名")<br />     (setq pt1   (getpoint "\n请输入图名插入点：")<br />     tm_txt (getstring "\n请输入图名：")<br />     sc   (getvar "userr1"))<br />     (setq scc (getstring "\n请输入比例：(1:?) <100>"))<br />     (IF  (= scc "")<br />   (SETQ scc "100"))<br />     (setq *bl* (strcat "1:" scc))<br />     (t_mak "图名"<br />      '(0 0 0)<br />      pt1<br />      tm_txt<br />      0<br />      1<br />      0<br />      (* 7 sc)<br />      0.75<br />      "standard")<br />     (setq txt_obj (cons (vlax-ename->vla-object (entlast)) nil))<br />     (setq ptl (textbox (entget (entlast))))<br />     (setq ptl (mapcar '- (cadr ptl) (car ptl)))<br />     (setq pta (polar pt1 pi (+ (/ (car ptl) 2) (* 1.5 sc))))<br />     (setq pta (polar pta (* 1.5 pi) (* 1.5 sc)))<br />     (setq ptb (polar pt1 0 (+ (/ (car ptl) 2) (* 1.5 sc))))<br />     (setq ptb (polar ptb (* 1.5 pi) (* 1.5 sc)))<br />     (setq ptl (list pta ptb))<br />     (pl_mak ptl "图名" (* 0.5 sc))<br />     (setq pl_obj (cdr (assoc 5 (entget (entlast)))))<br />     (setq ptc (polar (polar ptb (* 0.5 pi) (* 1.5 sc)) 0 sc))<br />     (t_mak "图名" ptc ptc *bl* 0 0 0 (* 4 sc) 0.75 "standard")<br />     (setq bl_obj (cdr (assoc 5 (entget (entlast)))))<br />     (creat_objreactor txt_obj (list pl_obj bl_obj))<br />     (IF  (NOT *COMMANDREACTOR*)<br />   (SETQ *COMMANDREACTOR*<br />      (VLR-PERS (VLR-COMMAND-REACTOR<br />              NIL<br />              '((:VLR-COMMANDWILLSTART<br />           .<br />           CMD-START)<br />          (:VLR-COMMANDENDED<br />           .<br />           CMD-ENDED)))))))<br /> <br />

xyp1964

帝都划水王

如下图截图

烟盒迷唇

求出包围盒，然后外扩，取得两点坐标画线

wangsr

xyp1964 发表于 2024-1-17 22:26

不错，怎么实现的？

llsheng_73

直接给字符加%%U不行么？

帝都划水王

xyp1964 发表于 2024-1-17 22:26

很强，是预想的效果

帝都划水王

x_s_s_1 发表于 2024-1-18 11:03
胡编乱造小bug版

把那个比例删了就差不多了，可以的