[原创]文本加下划线程序

langjs

回复 hdlyt11 的帖子

;;; =================================================================
;;; 文本加杨红颜色下划线
;;; 作者：langjs   　　　　命令：TT 　　　　　  日期2011年1月6日
;;; =================================================================
(defun c:TT (/ box ent ent1 h nent1 nent2 np1 np2 np3 np4 old_lay p p1x p1y p2x p2y px py r snap test)
  (setq ent1 (car (entsel "\n选择文本：")))
  (setvar "cmdecho" 0)                       ; 关闭命令响应
  (command ".UNDO" "BE")               ; 设置undo起点
  (setq snap (getvar "osmode"))
  (setvar "osmode" 0)                       ; 关闭捕捉
  (setq old_lay (getvar "clayer"))     ; 保存当前图层
  (setq ent (entget ent1))
  (if (= "MTEXT" (cdr (assoc 0 ent)))  ; 如选多行文本，则转化为单行文本
    (progn
      (command ".EXPLODE" ent1)
      (setq ent1 (entlast))
      (setq ent (entget ent1))
    )
    (princ)
  )
  (setq p (cdr (assoc 10 ent))               ; 文本基点坐标
        h (cdr (assoc 40 ent))               ; 文本高度
        r (cdr (assoc 50 ent))               ; 文本旋转角度
        TEST (cdr (assoc 8 ent))       ; 文本所在图层

  )
  (setq box (textbox ent))               ; 文本框坐标
  (setq p1x (car (car box))               ; 文本左下角X坐标
        p1y (car (cdr (car box)))
        p2x (car (car (cdr box)))      ; 文本右上角X坐标
        p2y (car (cdr (car (cdr box))))
        px (car p)
        py (car (cdr p))
  )                                       ; 下面程序计算划线的起终点坐标。如需修改只需调整0.2、0.3、0.56三个参数
  (setq np1 (list (- px (* h 0.2)) (- py (* h 0.3)) 0.0)) ; 第一条线段左端点坐标。(* h 0.2)指水平方向距离文本基点0.2倍文本高度，(* h
                                       ; 0.3)竖直方向距0.3倍字高。
  (setq np2 (list (+ p2x (+ px (* h 0.2))) (- py (* h 0.3)) 0.0)) ; 第一条线段右端点坐标
  (setq np3 (list (- px (* h 0.2)) (- py (* h 0.56)))) ; 第二条线段左端点坐标
  (setq np4 (list (+ p2x (+ px (* h 0.2))) (- py (* h 0.56)) 0.0)) ; 第二条线段右端点坐标
  (SETVAR "CLAYER" TEST)               ; 文本所在图层设为当前图层
  (COMMAND "pline" np1 "w" (/ h 10) (/ h 10) np2 "") ; 第一条下划线。(/ h
                                       ; 10)指第一条下划线宽度为文本高度的0.1倍，如需调整下划线宽度可以调整10的数值。
  (setq nent1 (entlast))
  (COMMAND "line" np3 np4 "")               ; 第二条下划线
  (setq nent2 (entlast))
  (COMMAND "CHPROP" nent1 "" "C" "6" ""); 第一条下划线更改为洋红颜色
  (COMMAND "CHPROP" nent2 "" "C" "6" ""); 第二条下划线更改为洋红颜色
  (if (/= r 0.0)                       ; 如果文本不水平则旋转下划线角度
    (progn
      (COMMAND "rotate" nent1 "" p (* 180.0 (/ r pi)))
      (COMMAND "rotate" nent2 "" p (* 180.0 (/ r pi)))
    )
  )
  (setvar "osmode" snap)
  (setvar "clayer" old_lay)               ; 恢复当前图层
  (command ".UNDO" "E")
  (princ)
)

hdlyt11

非常完美，最重要的是楼主把每句源码的用途写出来了，这样对新手学习是非常有用的，非常的感谢和钦佩。

sy100

谢谢楼主，送上新年祝福！

blyl

谢谢楼主

blyl

很好用

crazylsp

很好用,讲解非常详细,谢谢了

zwf100

终于找到你了，最近正要它

dongbeiren

多谢无私奉献 ！！！

yjr111

用处很大！与贱人工具箱的图名线一模一样了，又掏到一个好源码！

doro

不错不错 稍微改一下就画一条直线