明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 13084|回复: 51

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

    [复制链接]
发表于 2011-1-6 23:42 | 显示全部楼层 |阅读模式
本帖最后由 langjs 于 2011-1-7 11:00 编辑

   自己编写了一个文本加双下划线程序,程序比较简单,有需要的拿去用,有什么建议请反馈。QQ59509100
  1月7日根据网友建议更新。

;;; =================================================================
;;; 文本加下划线
;;; 作者: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))
  (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)
)

评分

参与人数 1明经币 +1 收起 理由
vlisp2012 + 1

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2022-5-3 23:02 | 显示全部楼层
如果要实现框选多段文字,分别绘制下划线,程序如下,十分简洁:
  1. ;; Double Underline - Multiple
  2. (defun c:munder2 ( )
  3.     (LM:strikethrough:selection
  4.        '(
  5.             (-0.8  0.05)
  6.             (-1.0  0.05)
  7.         )
  8.     )
  9. )
发表于 2023-11-14 22:48 | 显示全部楼层
langjs 发表于 2011-1-7 15:09
回复 hdlyt11 的帖子

;;; =================================================================

郎大师,能否多行文字每行下面画一条?
发表于 2022-6-18 11:25 | 显示全部楼层
reeves7 发表于 2022-5-3 22:58
文本加双下划线程序,去年Lee—Mac大神发布了一个代码量非常少的lisp程序,实现了同样的功能。我移花接木一 ...

支持框选吗?
发表于 2011-1-6 23:46 | 显示全部楼层
支持楼主支持源码
发表于 2011-1-7 00:52 | 显示全部楼层
谢谢!试过了,很好用。
发表于 2011-1-7 00:59 | 显示全部楼层
请教楼主:文字和粗线之间的距离和线段两头的长短是由哪些参数控制。简单地说:我想调节文字与下方线段之间的距离和线段的长度。谢谢!
发表于 2011-1-7 08:51 | 显示全部楼层
支持楼主展示源码,学习了
发表于 2011-1-7 09:10 | 显示全部楼层
谢谢楼主提供的源码
收藏,下来学习学习
 楼主| 发表于 2011-1-7 09:25 | 显示全部楼层
回复 sy100 的帖子

  1. ; 下面程序计算划线的起终点坐标。如需修改只需调整0.2、0.3、0.56三个参数值大小即可。
  2.   (setq np1 (list (- px (* h 0.2)) (- py (* h 0.3)) 0.0))         ;第一条线段左端点坐标。(* h 0.2)指水平方向距离文本基点0.2倍文本高度,(* h 0.3)竖直方向距0.3倍字高。
  3.   (setq np2 (list (+ p2x (+ px (* h 0.2))) (- py (* h 0.3)) 0.0)) ;第一条线段右端点坐标。计算方法同上。
  4.   (setq np3 (list (- px (* h 0.2)) (- py (* h 0.56))))            ;第二条线段左端点坐标。计算方法同上。
  5.   (setq np4 (list (+ p2x (+ px (* h 0.2))) (- py (* h 0.56)) 0.0));第二条线段右端点坐标。计算方法同上。


  6. ;另外还有一句程序
  7. (COMMAND "pline" np1 "w" (/ h 10) (/ h 10) np2 "") ; 第一条下划线。(/ h 10)指第一条下划线宽度为文本高度的0.1倍,如需调整下划线宽度可以调整10的数值。
发表于 2011-1-7 09:54 | 显示全部楼层
图层还需处理一下,生成的下划线是图中的当前图层和线性,可否使其为单独图层或者随文字所在图层,且为实线?
 楼主| 发表于 2011-1-7 11:02 | 显示全部楼层
hdlyt11 发表于 2011-1-7 09:54
图层还需处理一下,生成的下划线是图中的当前图层和线性,可否使其为单独图层或者随文字所在图层,且为实线 ...

已经更新,下划线画到文本层了
发表于 2011-1-7 14:46 | 显示全部楼层
还能把下划线颜色改为6号洋红吗?

点评

已经给你改好了  发表于 2011-1-7 15:10
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-29 12:42 , Processed in 0.230808 second(s), 30 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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