请求论坛lisp高手帮帮忙
请论坛lisp高手帮忙写个带字母箭头的程序，不胜感激！
方向如上图所示，字母总是在箭头上方，两点画箭头，先拾取一点，放置箭头的尾部，指定第二点放置箭头，类似于画直线，指定第一点后，会从第一点到鼠标指针引一条线
另外，字母可以输入其它，字高可以改变，箭头大小等于字高，箭头带线总长度等于４倍的字高
http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 该贴已经同步到 sibelle_hu的微博 在本论坛和百度上找了好久,都没有一个像样点的箭头绘制程序,请高手出马啊 ! 终于找了一个箭头的绘制程序，高手能帮我改一改吗？(defun c:Arrow (/ a b)
;; Draw quick arrow
;; Alan J. Thompson
(if (and (setq a (getpoint "\nSpecify first point: "))
(setq b (getpoint a "\nSpecity next point: "))
)
(command "_.leader" "_non" a "_non" b "" "" "_N")
)
(princ)
)
大师，玩不转呀，演示非常不错，缺少xyp开头的几个自定义函数，看说明是不是要装e派工具箱？还要注册？ (defun c:tt ()
(setvar "CMDECHO" 0)
(setq txt (getstring "\n标注内容: "))
(while (and (setq pt1 (getpoint "\n起点: "))
(setq pt2 (getpoint pt1 "\n终点: ")))
(setq dis (distance pt1 pt2)
ang (angle pt1 pt2)
ang2 (angle pt2 pt1)
ll (/ dis 4)
dd (/ dis 10)
ptm (mapcar '(lambda(a b) (/ (+ a b) 2)) pt1 pt2))
(setq ang1 (if (< (/ (* pi 2) 3) ang (/ (* pi 5) 3)) pi 0))
(setq an (+ ang (/ pi 2) ang1))
(command "_.PLINE" pt1 (polar pt2 ang2 ll) "W" dd 0 pt2 "")
(if (/= txt "")
(command "_.TEXT" "TC" (polar ptm an ll) dd (/ (* (- an (/ pi 2)) 180) pi) txt)
)
)
(setvar "CMDECHO" 1)
(princ)
)
本帖最后由 sibelle_hu 于 2014-8-11 09:10 编辑
ZZXXQQ 发表于 2014-8-11 08:26 static/image/common/back.gif
感谢超版的帮忙，还有点问题，就是现在是靠拾取两点间的长度来定箭头大小与字母大小，我要的是，运行程序后可以设定字高，箭头大小等于字高，箭头带线总长度等于４倍的字高，也就是说拾取的两点并不能决定箭头的总长，因为设定字高后，总长就以经定下来了，拾取的第二点只是定箭头的方向。 学习一下。 我觉着吧,做成块更方便些,主要是方便以后读取数据,批量修改大小等~~~ 谢谢你的向视图符号
页:
[1]