tyrasv 发表于 2014-12-25 21:19:23

文字加下划线！ 求专家

能框选全部文字加上下滑线，最好能告知怎么修改下划线长度和离文字高度，和下划线宽度。   希望能给个成果的

成仔 发表于 2014-12-25 21:19:24

tyrasv 发表于 2015-1-5 17:47 static/image/common/back.gif
感觉不错，可是我只要一条下滑线就行了，你这个好像是生成了2条线，一条粗的和一条细的。

         把这两句删掉就行，(command "pline" (polar pt_bl (* pi 1.5) (* roundspace 0.6)) "w" 0 "" (polar pt_br (* pi 1.5) (* roundspace 0.6)) "")
         (command "CHPROP" (entlast) "" "C" "BYBlock" "")

lucas_3333 发表于 2014-12-25 21:44:48

http://bbs.mjtd.com/thread-100438-1-1.html

lucas_3333 发表于 2014-12-25 21:48:07

想起来了，黄总还有一个类似程序 http://bbs.mjtd.com/thread-108748-1-1.html

xyp1964 发表于 2014-12-25 22:47:57



悲催的设计师-MZ 发表于 2014-12-26 00:13:02

学习了学习了学习了

郭文姬happy 发表于 2014-12-26 14:30:09

(defun c:40()
(initget "T B A")
(setq typ (getkword"\n 画线样式<B>:"))
(if (null typ)(setq typ "B"))
(setq dd (getdist"\n输入字间与圆周距离<2>:"))
(if(null dd)(setq dd 2.0))
(setq ss(ssget))
(setq i 0)
(repeat (sslength ss)
(setq ssn (ssname ss i))
(setq ssdata (entget ssn))
(setq key (cdr (assoc 0 ssdata)))
(if (= key "TEXT")
(progn
(command "ucs" "e" ssn)
(setq box (textbox ssdata))
(setq p1 (car box))
(setq p3 (cadr box))
(setq p2(list (car p3)(cadr p1)))
(setq p4(list (car p1)(cadr p3)))
(setq ang (angle p1 p4))
(setq ee (entlast))
(cond ((= typ "T") (command "line"(polar p4 ang old)(polar p3 ang dd)""))
      ((= typ "B") (command "line"(polar p1(- ang )dd)(polar p2(- ang) dd)""))
      ((= typ "a") (command "line"(polar p4 ang old)(polar p3 ang dd)""))
      (command"line" (polar p1 (-ang)dd)(polar p2 (- ang)dd)""))
)
)
)
(setq i (1+ i))
)
(command "ucs" "")
(prin1)
)

tyrasv 发表于 2014-12-26 23:30:42

xyp1964 发表于 2014-12-25 22:47 static/image/common/back.gif


看的还行，但是缺个函数。

tyrasv 发表于 2014-12-26 23:33:12

本帖最后由 tyrasv 于 2014-12-26 23:38 编辑

郭文姬happy 发表于 2014-12-26 14:30 static/image/common/back.gif
(defun c:40()
(initget "T B A")
(setq typ (getkword"\n 画线样式:"))

改哪个数可以加线段长度啊，我不回，长度改为比文字长一个字最好，一样长看的不美观。

陨落 发表于 2014-12-27 21:22:04

应该搞个反应器，能自动变下划线长度
页: [1] 2 3
查看完整版本: 文字加下划线！ 求专家