代码我看了，挺好的，无奈我改不了源码，我不要写数字，我要画箭头，我写好了一个，也实现了。
箭头?leader不就行了吗？
可否上载图片示范为何画箭头要写代码？
p/s:猜测可能是block箭头块? lisperado 发表于 2019-12-19 18:01
箭头?leader不就行了吗？
可否上载图片示范为何画箭头要写代码？
;;;;;;;三领-定距拉伸;;;;;;框选样式代码;;;;;;;;;;;;;;;;;;;;;;;;
;;:1:可以定点定距离
;;:2:可以任意拉伸
;;:3:可以输入距离拉伸
;;;4:和原CAD一样，具有拖曳效果
(defun c:tt (/ pt1 pt2 ang ss oldorh oldosm)
(sl-cishu)
(setq pt1 (getpoint "\n第一框角点: ")
pt2 (getcorner pt1 "\n第二框角点: ")
)
(prompt "\n 移动鼠标定-->拉伸方向:")
(command "select" "c" pt1 pt2 "")
(setq ss (ssget "p"))
(setq pt1 (yy:mid pt1 pt2))
(setq ang (4dire1 pt1))
(sldis)
(setq sldis1 (/ sl-dis (getvar "dimlfac")))
(setq pt2 (polar pt1 ang sldis1))
(command "_.stretch" ss "" pt1 pt2)
(princ)
)
;;说明:;;方向轮函数=【开始】==========================(一级)==============================
;;说明:;pt1 方向轮几点 返回 ang取得角度
(defun 4dire1 (pt1 / gr grr p1 os loop lastss)
;;;;;;;;生成方位图--------------------------------
(defun entmake-fx (pt1 pt / ss1)
(if lastss (SL:PickSet-Erase lastss))
(slslx pt1 0)
(setq ss1 (entlast)) ;;;;;;构造最后一个实体选择集
(entmakeX ;;;;;;;;;;;;;;;;;;;;;创建 LEADER 对象
(list '(0 . "LEADER")
'(100 . "AcDbEntity")
'(100 . "AcDbLeader")
'(40 . 0.9875)
(cons 62 1)
(cons 10 pt)
(cons 10 pt1)
(list -3
(list "ACAD"
'(1000 . "DSTYLE")
'(1002 . "{")
'(1070 . 41)
(cons 1040 (* 5.0 SLBL));;;;;箭头大小
'(1002 . "}")
)
)
)
)
(entmake (list '(0 . "CIRCLE") (cons 62 6) (cons 6 "xx")(cons 10 pt1) (cons 40 (* SLBL 10.0))))
(setq lastss (last_ent ss1))
)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq loop t)
(while loop
(setq grr (grread t));请求输入
(setq gr (car grr))
(setq p1 (cadr grr))
(cond
((= gr 5);移动时
(setq ang (angle pt1 p1))
(if (and (>= ang 0.0)(< ang (* 0.25 pi)));;;向右
(progn
(setq pt (polar pt1 0 (* 15.0 slbl)))
(setq ang 0.0)
)
)
(if (>= ang 5.5) ;;;向右
(progn
(setq pt (polar pt1 0 (* 15.0 slbl)))
(setq ang 0.0)
)
)
(if (and (>= ang (* 0.25 pi))(< ang (* 0.75 pi))) ;;;;;向上
(progn
(setq pt (polar pt1 (* 0.5 pi) (* 15.0 slbl)))
(setq ang (* 0.5 pi))
)
)
(if (and (>= ang (* 0.75 pi))(< ang (* 1.25 pi))) ;;;;;向左
(progn
(setq pt (polar pt1 pi (* 15.0 slbl)))
(setq ang pi)
)
)
(if (and (>= ang (* 1.25 pi))(< ang (* 2.0 pi))) ;;;;;向下
(progn
(setq pt (polar pt1 (* 1.5 pi) (* 15.0 slbl)))
(setq ang (* 1.5 pi))
)
)
(entmake-fx pt1 pt)
)
((or(equal grr '(2 32));空格
(equal gr 3);左键
(equal grr '(2 13));回车
(equal grr'(11 0));右击
)
(setq loop nil)
)
)
)
(if lastss (SL:PickSet-Erase lastss))
(redraw)
(setvar "osmode" os)
ang
)
;;说明:;;方向轮函数===================【结束】=====================================
很牛X的样子
大神为了少按一个键也够拼了
页:
1
[2]