[求助]这条直线应如何获得跟字一样长

wengsg

如图，我不需要用下划线来实现，我要的是画直线。lsp应如何编，请指教！ (defun c:test (/ base text0)
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setvar "TEXTEVAL" 1)
(SETQ base (getstring "\n指定文字位置 :"))
(SETQ txt0 (getstring "\n请输入文字 :"))
(command "text" "j" "ml" base "2.5" "0" txt0)
(setq base (mapcar '+ base '(0.0 1.0)))
(command "line" base 　－－－“这里该怎么写？这条线与文字基本一样长，如何获得？”－－－－－)
(setvar "cmdecho" 1)
(princ)
)

ljpnb

这是我改得: (defun c:test ()
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setvar "TEXTEVAL" 1)
(SETQ base (getpoint "\n指定文字位置 :"))
(SETQ txt0 (getstring "\n请输入文字 :"))
(command "text" "j" "tr" base "2.5" "0" txt0)
(setq en0(entlast))
(setq en(entget en0))
(setq p00 (list (cadr (assoc 10 en)) (caddr (assoc 10 en))))
(setq L (abs(- (cadr (assoc 11 en)) (cadr (assoc 10 en)))))
(command "move" en0 "" p00 base)
(setq base (mapcar '- base '(0.0 1.0)))
(setq base1 (polar base 0 L))
(command "line" base base1 "")
(setvar "cmdecho" 1)
(setvar "osmode" 37)
(princ)
)

f5612140

(defun c:tbline()
(setq ss (ssget))
(setq ss (ssget "p" '((0 . "TEXT"))))
(setq i 0)
(repeat (sslength ss)
(setq ssn (ssname ss i))
(setq ssdata (entget ssn))
(command "ucs" "e" ssn)
(setq box (textbox ssdata))
(setq p1 (car box))
(setq p3 (cadr box))
(setq p2 (list (car p3) (cadr p1)))
(setq p4 (list (car p1) (cadr p3)))
(command "line" p1 p2 "") ;请自己调整距离文字的位置
(setq i (1+ i))
)
(command "ucs" "")
(PRIN1)
)

wengsg

受益非浅！谢谢各位！

oyxx1023

不知道如果文字有高宽比时上面几位的程序是不是正确的。

无痕

比较支持三楼

xstlf

三楼的这思路真的很好呵,好久没来了,好想大家呀,这些天快过年了,忙着讨钱,一直没空来呀.

贱人

(command "line" p1 p2 "") ;请自己调整距离文字的位置
如果我要设置线和文字相距10,怎么改啊??

xyp1964

下划线加粗并自动确定位置：（按1:100出图考虑，线宽60，字与线间距150）

2. ;;;下划线
3. (defun C:xhx (/ e m pt1 pt2 x1 y1 x2 y2 pt1 pt2)
4.    (setvar "CMDECHO" 0)
5.    (setvar "osmode" 0)
6.    (setq  e   (car (entsel "\n选择文字 : "))
7.   sc 1
8.    )
9.    (command "ucs" "Entity" e)
10.    (setq  M     (textbox (entget e))
11.   pt1 (car M)
12.   pt2 (cadr M)
13.   x1   (car pt1)
14.   y1   (cadr pt1)
15.   x2   (car pt2)
16.   y2   (cadr pt2)
17.   y1   (- y1 (* 150 SC))
18.   y2   (- y2 (* 150 SC))
19.   pt2 (list x2 y1)
20.   pt1 (list x1 y1)
21.    )
22.    (command "pline" pt1 "w" (* 60 sc) "" pt2 "")
23.    (command "ucs" "p")
24.    (princ)
25. )

;;;下划线 (defun C:xhx (/ e m pt1 pt2 x1 y1 x2 y2 pt1 pt2)    (setvar "CMDECHO" 0)    (setvar "osmode" 0)    (setq  e   (car (entsel "\n选择文字 : "))   sc 1    )    (command "ucs" "Entity" e)    (setq  M     (textbox (entget e))   pt1 (car M)   pt2 (cadr M)   x1   (car pt1)   y1   (cadr pt1)   x2   (car pt2)   y2   (cadr pt2)   y1   (- y1 (* 150 SC))   y2   (- y2 (* 150 SC))   pt2 (list x2 y1)   pt1 (list x1 y1)    )    (command "pline" pt1 "w" (* 60 sc) "" pt2 "")    (command "ucs" "p")    (princ) )

贱人

好用的,不过1964兄,你的老毛病 程序结束,自定义的捕捉丢失 还有,我一般字下面是用2条线的,上面一条有宽度,下面一条没宽度,两线距离100,这样行哇?