(defun c:Arrow (/ _group _dist lastentity p1 p2 ent obj gr coords pt)
;; Draw quick arrow
;; Alan J. Thompson, 03.13.11
(defun _group (l)
(if (caddr l)
(cons (list (car l) (cadr l) (caddr l)) (_group (cdddr l)))
)
)
(defun _dist (a b) (distance (list (car a) (cadr a)) (list (car b) (cadr b))))
(setq lastentity (entlast))
(if (and (setq p1 (getpoint "\nSpecify first point: "))
(setq p2 (getpoint p1 "\nSpecity next point: "))
(vl-cmdf "_.leader" "_non" p2 "_non" p1 "" "" "_N")
(not (equal lastentity (setq ent (entlast))))
(setq obj (vlax-ename->vla-object ent))
)
(while (eq 5 (car (setq gr (grread T 15 0))))
(redraw)
(grdraw (cadr gr)
(trans (vlax-curve-getClosestPointTo ent (setq pt (trans (cadr gr) 1 0))) 0 1)
3
-1
)
(if
(equal
(last (setq coords (_group (vlax-get obj 'Coordinates))))
(car (vl-sort coords (function (lambda (a b) (< (_dist a pt) (_dist b pt))))))
)
(vlax-put obj 'Coordinates (apply (function append) (reverse coords)))
)
(grdraw (cadr gr) (trans (car coords) 0 1) 1 -1)
)
)
(redraw)
(princ)
)
(defun c:ArrowM
(/ _group _getPoints _arrow _closestpt AT:Arrow lastentity AT:Midpoint lst ent obj gr coords)
;; Draw Arrow
;; Alan J. Thompson, 03.13.11
(defun _group (l)
(if (caddr l)
(cons (list (car l) (cadr l) (caddr l)) (_group (cdddr l)))
)
)
(defun _getPoints (/ lst pt)
(if (car (setq lst (list (getpoint "\nSpecify first point: "))))
((lambda (color)
(while (setq pt (getpoint (car lst) "\nSpecify next point: "))
(redraw)
(mapcar (function (lambda (a b) (and a b (grdraw a b color -1))))
(setq lst (cons pt lst))
(cdr lst)
)
(AT:Arrow (car lst) (angle (cadr lst) (car lst)))
)
(redraw)
lst
)
(cdr (assoc 62 (tblsearch "LAYER" (getvar 'CLAYER))))
)
)
)
(defun _arrow (lst)
(mapcar
(function
(lambda (a b)
(and a b (AT:Arrow (trans (AT:MidPoint a b) 0 1) (angle (trans b 0 1) (trans a 0 1))))
)
)
lst
(cdr lst)
)
)
(defun _closestpt (lst p)
(car (vl-sort lst (function (lambda (a b) (< (distance a p) (distance b p))))))
)
(defun AT:Arrow (#Location #Angle / #Size #Point1 #Point2 #Point3)
;; Display directional arrow
;; #Location - arrow placement point
;; #Angle - arrow directional angle
;; Alan J. Thompson, 04.28.09
(setq #Size (* (getvar "viewsize") 0.02)
#Point1 (polar #Location #Angle #Size)
#Point2 (polar #Location (+ #Angle (* pi 0.85)) #Size)
#Point3 (polar #Location (+ #Angle (* pi 1.15)) #Size)
)
(grvecs (list 4 #Point1 #Point2 #Point2 #Point3 #Point3 #Point1))
#Location
)
(defun AT:Midpoint (p1 p2)
;; Midpoint between two points
;; Alan J. Thompson, 04.23.09
(mapcar (function (lambda (a b) (/ (+ a b) 2.))) p1 p2)
)
(setq lastentity (entlast))
(if (and (setq lst (_getPoints))
(progn (vl-cmdf "_.leader") (foreach p lst (vl-cmdf "_non" p)) (vl-cmdf "" "" "_N"))
(not (equal lastentity (setq ent (entlast))))
(setq obj (vlax-ename->vla-object ent))
)
(while (eq 5 (car (setq gr (grread T 15 0))))
(redraw)
(grdraw (cadr gr) (trans (vlax-curve-getClosestPointTo ent (trans (cadr gr) 1 0)) 0 1) 3 -1)
(grdraw (cadr gr) (trans (car (setq coords (_group (vlax-get obj 'Coordinates)))) 0 1) 1 -1)
(_arrow coords)
(if (equal (last coords) (_closestpt coords (trans (cadr gr) 1 0)))
(vlax-put obj 'Coordinates (apply (function append) (reverse coords)))
)
)
)
(redraw)
(princ)
)
箭头
阿罗姆 Alan对我的原始代码进行了修改，以匹配箭头末端选择，并演示了：
(defun c:arrow ( / di en gr l1 l2 nm p1 p2 )
(if
(and
(setq p1 (getpoint "\n1st Point: "))
(setq p2 (getpoint "\n2nd Point: " p1))
)
(progn
(setq di (/ (distance p1 p2) 3.0)
nm (trans '(0. 0. 1.) 1 0 t)
)
(setq en
(entget
(entmakex
(append
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(90 . 3)
'(70 . 0)
)
(setq l1
(list
(cons 10 (trans p1 1 nm))
(cons 10 (trans (polar p2 (angle p2 p1) di) 1 nm))
(cons 40 (/ di 2.0))
'(41 . 0.0)
(cons 10 (trans p2 1 nm))
(cons 210 nm)
)
)
)
)
)
)
(setq l2
(list
(cons 10 (trans p1 1 nm))
'(40 . 0.0)
(cons 41 (/ di 2.0))
(cons 10 (trans (polar p1 (angle p1 p2) di) 1 nm))
(cons 10 (trans p2 1 nm))
(cons 210 nm)
)
)
(setq en (reverse (member (assoc 39 en) (reverse en))))
(princ "\nChoose Arrow End...")
(while (= 5 (car (setq gr (grread t 13 0))))
(entmod
(append en
(if (< (distance (cadr gr) p2) (distance (cadr gr) p1)) l1 l2)
)
)
)
)
)
(princ)
) 美好的我必须补充的是，我从未在arrow代码上使用过动态选项，也从未使用过arrowm代码。Arrow是我非常简单的Arrow例程的重写，arrowm模仿了我们定期发布到grread示例线程@theswamp时编写的一个例程，因此所有的grdraw都是愚蠢的。 啊，我一整天都不能用电脑来澄清一些事情！该死的付费客户总是让一切变得如此困难。
我们的绘图标准要求我们绘制大多数东西w/（LW）PLINE，并给它们一个2“宽度。因此，我认为维度解决方案不适用于这个复杂的箭头。在这方面我已经做好了准备，但李对我所做的事情的澄清提醒我，几年前，我的第一次尝试是将箭头作为一个单一实体，完全像他那样用头和尾固定，然后对其进行样条化。但每次我对其进行样条化，它都会扰乱厚度的变化。（从0开始，转到箭头宽度，然后向下到尾部宽度，依此类推）我只是再试了一次，我把李的箭头，附加了2个额外的部分（在零宽度），然后用花键。它整个过程都变成了零宽度的样条曲线，没有头。
所以我当时的解决方案是制作样条曲线，添加一个箭头块，然后将它们组合在一起。所以李的解决方案提醒了我，现在我问，我可以用一个实体来做吗？只是为了学习。
我今天感觉很好，好像我参与了对话。我想我会再试一次。（提出某人问题的解决方案。）
是的，我在想什么。我应该直接在entmakex上加入宽度
谢谢李。
干杯，伙计，哈哈，我不使用我的任何程序——有趣的是写它们。 总是这样。 艾伦
我经常使用你的单箭头程序。
但是我想知道，我想在一个图形中有两种不同的引线样式，都是相同的大小，但一个是闭合填充的，另一个是空白填充的。实现这一目标的最佳方式是什么？
谢谢
P 你可以改变那一个属性，但因为你有不同的风格，我想你宁愿把它们作为合适的风格。我决定将其作为一个子例程，您可以在其中指定样式（或者对于当前样式，将其保留为零）。。。
6 干杯，艾伦
一旦我完成这该死的船厂调查，我会试试的。。
页:
1
[2]