明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 897|回复: 0

[提问] 双下划线如何能突出文字左右边一点

[复制链接]
发表于 2021-6-4 20:49:22 | 显示全部楼层 |阅读模式
请教下大神么,下面的双下划线的某大神的源码,该如何实现双下划线如何能突出文字左右边一点呢,那个代码是实现这个功能的,试了很久试不出来

;;;双下划线
(defun C:zzx (/              HOLDECHO              HOLDWID HOLDOSMODE      HOLDCLAYER
              SS      TEXTM   TEXTM1  M10     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 "LINEWID"))
  (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 "" "" "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 "" "" "LA" "W-DIM" "C" 4 "")
     ;;把线移至DIM层,COLOR为紫色
     (command "_.ucs" "p")
    )
  )
  (setvar "LINEWID" HOLDWID)
  (setvar "OSMODE" HOLDOSMODE)
  (setvar "CMDECHO" HOLDECHO)
  (command "_.UNDO" "END")
  (princ)
)

"觉得好,就打赏"
还没有人打赏,支持一下
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2025-5-16 19:43 , Processed in 0.175405 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表