双下划线如何能突出文字左右边一点
请教下大神么，下面的双下划线的某大神的源码，该如何实现双下划线如何能突出文字左右边一点呢，那个代码是实现这个功能的，试了很久试不出来;;;双下划线
(defun C:zzx (/ HOLDECHO HOLDWID HOLDOSMODE HOLDCLAYER
SS TEXTM TEXTM1M10 M40 M42 M43
M50 M71 PT1 PT2 PT3 PT4 PT5
PT6 PT7 PT8 PT9 RT TB DIST
DIST1 D ANG
)
(command "_.UNDO" "BE")
(setq HOLDOSMODE (getvar "OSMODE"))
(setq HOLDCLAYER (getvar "CLAYER"))
(setq HOLDECHO (getvar "CMDECHO"))
(setq HOLDWID (getvar "PLINEWID"))
(setvar "CMDECHO" 0)
(setvar "OSMODE" 0)
(if (= (tblsearch "LAYER" "DIM") NIL)
(command "_.layer" "m" "dim" "c" "cyan"
"" "lt" "continuous" ""
""
)
)
(setvar "CLAYER" HOLDCLAYER)
(while (= TEXTM1 NIL)
(setq TEXTM1 (car (nentsel "\n请点选文字加双下划线: ")))
(if (/= TEXTM1 NIL)
(progn
(setq TEXTM (entget TEXTM1))
(if (and (/= "MTEXT" (cdr (assoc 0 TEXTM)))
(/= "TEXT" (cdr (assoc 0 TEXTM)))
)
(progn
(setq TEXTM1 NIL)
(prompt (strcat "\n点选对象为" (cdr (assoc 0 TEXTM))))
)
)
)
)
)
(cond
((= "MTEXT" (cdr (assoc 0 TEXTM)))
(command "_.ucs" "W")
(setq M10 (cdr (assoc 10 TEXTM)))
(setq M40 (cdr (assoc 40 TEXTM)))
(setq M42 (cdr (assoc 42 TEXTM)))
(setq M43 (cdr (assoc 43 TEXTM)))
(setq M50 (cdr (assoc 50 TEXTM)))
(setq M71 (cdr (assoc 71 TEXTM)))
(setq PT9 (list (+ (car M10) M42) (cadr M10) (caddr M10)))
(setq PT3 (list (car PT9) (+ (cadr PT9) M43) (caddr PT9)))
(setq PT1 (list (car M10) (+ (cadr M10) M43) (caddr M10)))
(setq PT8 (list (+ (car M10) (/ M42 2)) (cadr M10) (caddr M10)))
(setq PT4 (list (car M10) (+ (cadr M10) (/ M43 2)) (caddr M10)))
(setq PT2 (list (+ (car M10) (/ M42 2))
(+ (cadr M10) M43)
(caddr M10)
)
)
(setq PT6 (list (+ (car M10) M42)
(+ (cadr M10) (/ M43 2))
(caddr M10)
)
)
(setq SS (ssadd))
(setq ANG (angle PT1 M10))
(setq M101 (polar M10 (+ ANG pi) (* M40 0.05)))
;;(setq M101 (polar M10 ANG (* M40 0.05)))那是第一点与字距离方向不同
;;计算第一点与字距离(* M40 0.05),其实对每种字体会有误差,可自行修正
(setq PT91 (polar PT9 (+ ANG pi) (* M40 0.05)))
;;(setq PT91 (polar PT9 ANG (* M40 0.05)))那是第一点与字距离方向不同
;;计算第二点与字距离(* M40 0.05),其实对每种字体会有误差,可自行修正
(command "_.PLINE"
M101
"W"
(* M40 (/ 3 40.0))
""
PT91
"W"
0
""
""
)
;;计算线宽(* M40 (/ 3 40.0))
(ssadd (entlast) SS)
(command "_.MOVE"
(entlast)
""
"0,0"
(polar '(0 0) ANG (* M40 (/ 3 16.0)))
;;第一条线与字的移动距离,M40=字高
)
(command "_.LINE" M101 PT91 "")
(command "_.MOVE"
(entlast)
""
"0,0"
(polar '(0 0) ANG (* M40 (/ 26 80.0)))
;;第二条线与字的移动距离,M40=字高
)
(ssadd (entlast) SS)
(setq PT5 (inters M10 PT3 PT9 PT1))
(cond
((= 1 M71) (command "._move" SS "" PT1 M10)) ;1 = Top left
((= 2 M71) (command "._move" SS "" PT2 M10)) ;2 = Top center
((= 3 M71) (command "._move" SS "" PT3 M10)) ;3 = Top right
((= 4 M71) (command "._move" SS "" PT4 M10)) ;4 = Middle left
((= 5 M71) (command "._move" SS "" PT5 M10)) ;5 = Middle center
((= 6 M71) (command "._move" SS "" PT6 M10)) ;6 = Middle right
;;; ((= 7 M71) (command "._move" SS "" M10 M10)) ;7 = Bottom left
((= 8 M71) (command "._move" SS "" PT8 M10)) ;8 = Bottom center
((= 9 M71) (command "._move" SS "" PT9 M10)) ;9 = Bottom right
)
(command "_.ROTATE" SS "" M10 (/ (* 180 M50) pi))
(command "_.CHANGE" SS "" "P" "LA" "DIM" "C" 6 "")
;;把线移至DIM层,COLOR为紫色
(setq DIST (* M40 1.66))
(setq DIST1 (fix (/ M43 DIST)))
(setq D 1)
(repeat DIST1
(command "_.COPY"
SS
""
M10
(polar M10 (+ M50 (/ pi 2)) (* DIST D))
)
(setq D (+ 1 D))
)
(command "_.ucs" "p")
)
((= "TEXT" (cdr (assoc 0 TEXTM)))
(command "_.ucs" "Object" TEXTM1)
(setq TB (textbox (list (cons -1 TEXTM1))))
(setq PT1 (car TB)
PT2 (cadr TB)
PT3 (list (car PT1) (cadr PT2))
PT4 (list (car PT2) (cadr PT1))
)
(setq DIST (cdr (assoc 40 TEXTM)))
;;取出文字高度
(setq ANG (angle PT3 PT1))
(setq SS (ssadd))
(setq PT1 (polar PT1 (+ ANG pi) (* DIST 0.05)))
;;(setq PT1 (polar PT1 ANG (* DIST 0.05)))那是第一点与字距离方向不同
;;计算第一点与字距离(* DIST 0.05),其实对每种字体会有误差,可自行修正
(setq PT4 (polar PT4 (+ ANG pi) (* DIST 0.05)))
;;(setq PT4 (polar PT4 ANG (* DIST 0.05)))那是第一点与字距离方向不同
;;计算第二点与字距离(* DIST 0.05),其实对每种字体会有误差,可自行修正
(command "_.PLINE"
PT1
"W"
(* DIST (/ 3 30.0))
""
PT4
"W"
0
""
""
)
;;计算线宽(* DIST (/ 3 40.0))
(ssadd (entlast) SS)
(command "_.MOVE"
(entlast)
""
"0,0"
(polar '(0 0) ANG (* DIST (/ 3 15.0)))
;;第一条线与字的移动距离,DIST=字高
)
(command "_.LINE" PT1 PT4 "")
(command "_.MOVE"
(entlast)
""
"0,0"
(polar '(0 0) ANG (* DIST (/ 26 70.0)))
;;第二条线与字的移动距离,DIST=字高
)
(ssadd (entlast) SS)
(command "_.CHANGE" SS "" "P" "LA" "W-DIM" "C" 4 "")
;;把线移至DIM层,COLOR为紫色
(command "_.ucs" "p")
)
)
(setvar "PLINEWID" HOLDWID)
(setvar "OSMODE" HOLDOSMODE)
(setvar "CMDECHO" HOLDECHO)
(command "_.UNDO" "END")
(princ)
)
页:
[1]