[LISP程序]：给文字加下划线的小工具

xiagood · 发表于 2009-3-4 10:16:37

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

一个给文字加下划线的lisp.供大家参考使用。谢谢!

;;;程序名： UL
;;;用途：给多行文本、单行文本增减下划线.
;;;日期：2009/03/04
;;;作者：xiatian3639@sina.com

;;;-----------------------------增减文字下划线-----------------------------
(Defun ErrorUL(msg)
   (prin1)
)

(Defun C:UL(/ Textsel L N UlTxt UlEntget UlTxtCon UlTxtTyp UlFlag UlNewTxt)
  (setvar "cmdecho" 0)
  (setq *error* ErrorUL)
  (princ "\n选择需增减下划线文字:")
  (setq Textsel (ssget '((-4 . "<OR")
   (0 . "TEXT")
   (0 . "MTEXT")
   (-4 . "OR>"))
   ))
  (if (/= Textsel nil)
   (progn
   (setq L  0)
       (setq N (sslength Textsel))
   (while (< L N)
      (setq UlTxt (ssname TextSel L))
      (setq UlEntget (entget Ultxt))
      (setq UlTxtCon (cdr (assoc 1 UlEntget)))
      (setq UlTxtTyp (cdr (assoc 0 UlEntget)))
      (if (= UltxtTyp "TEXT")
   (progn
               (setq UlFlag (substr UlTxtCon 1 3))
               (if (= UlFlag "%%U")
            (setq UlNewTxt (substr UlTxtCon 4))
            (setq UlNewTxt (strcat "%%U" UlTxtCon))
               )
   )
   (progn
               (setq UlFlag (substr UlTxtCon 1 3))
               (if (= UlFlag "{\\L")
            (setq UlNewTxt (substr UlTxtCon 4 (- (strlen UlTxtCon) 4)))
            (setq UlNewTxt (strcat "{\\L" UlTxtCon "}"))
               )
   )
)
      (setq UlEntget (subst (cons 1 UlNewTxt) (assoc 1 UlEntget) UlEntget))
      (entmod UlEntget)
      (setq L (+ L 1))
   )
)
      (princ "\n未处理任何文字对象！")
)
(prin1)
)

jichengxing · 发表于 2009-3-4 15:06:02

看看

kevinsjw · 发表于 2009-3-4 22:37:43

有点意思啊

shenying123 · 发表于 2009-3-5 09:18:14

有点意思啊

lxch · 发表于 2009-3-6 15:42:40

谢谢，试用了，感觉线有点短，应该调整哪里？

qddlm · 发表于 2009-3-7 07:48:49

不错，实用小东东

belx · 发表于 2009-3-13 14:49:03

APPLOAD 已成功加载增减文字下划线.lsp。
命令: ; 错误: 输入的点对中含有多余的 cdrs

userzhluserzhl · 发表于 2009-3-13 15:09:44

加图名线示范

ljttjl · 发表于 2009-3-14 19:24:36

也可以使用以下程序（文字带下划线），见附件xswzcs.rar

zhengchuan1971 · 发表于 2009-3-20 14:14:36

有点意思啊

szlmh · 发表于 2009-3-24 12:19:50

好像不错，是不是公开的源码

ynjzlzd · 发表于 2009-3-25 09:11:01

麻烦楼主做一个文字加上划线的，且上划线与文字距离2－3mm,有时要用到。

tanle2020 · 发表于 2009-4-8 08:32:04

同7楼的一样，不知道是什么原因

chinalgy · 发表于 2009-4-8 21:22:01

不错啊，好东西，。。学习一下。。

njutfyj · 发表于 2009-4-13 00:01:27

谢谢各位楼主了

账号		自动登录	找回密码
密码			立即注册

[LISP程序]：给文字加下划线的小工具

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子