分享！沿cur的弧
来源：bbs。xdcad。org/thread-675894-1-1。html(defun mkarc (p w f / p1 p2)
(cond
((= f 3) (setq p1 (mapcar '- p (list (* -0.25 w) (* 0.5 (abs w)) ))
p2 (mapcar '- p (list 0 (abs w) ))
)
(vl-cmdf "arc" p p1 p2)
)
((= f 2) (setq p1 (mapcar '+ p (list (* 0.25 w) (* -0.5 (abs w)) ))
p2 (mapcar '+ p (list (* 0.25 w) (* 0.5 (abs w)) ))
)
(vl-cmdf "arc" p1 p p2)
)
((= f 1) (setq p1 (mapcar '+ p (list (* 0.25 w) (* 0.5 (abs w)) ))
p2 (mapcar '+ p (list 0 (abs w) ))
)
(vl-cmdf "arc" p p1 p2)
)
)
(entlast)
)
(defun mat:rotation ( cen ang / c s x y)
(setq c (cos ang) s (sin ang))
(setq x (car cen) y (cadr cen))
(list
(list c (- s) 0. (- x (- (* c x) (* s y))))
(list s c0. (- y (+ (* s x) (* c y))))
'(0. 0. 1. 0.)
'(0. 0. 0. 1.)
)
)
(defun HH:PtFirstAngle (obj pt)
(setq param (vlax-curve-getParamAtPoint obj pt))
(angle pt (mapcar '+ pt (vlax-curve-getFirstDeriv obj param)))
)
(defun c:tt ( / aa a an d d1 d2 e f i l odlst p1 p2 pr q w x y)
(setq odlst (mapcar 'getvar '("cmdecho" "osmode" "peditaccept")))
(mapcar 'setvar '("cmdecho" "osmode") '(0 544))
(setq w (getreal "\nEnter the width of arc :") ;If the value is negative, the direction of the arc is opposite
d (getreal "\nInput arc spacing :")
a (car (entsel "\nSelect the curve :"))
p1 (getpoint "\nStart point:")
p2 (getpoint "\nEnd point:")
l (list p1 p2)
l (vl-sort l '(lambda (x y) (< (vlax-curve-getDistAtPoint a x) (vlax-curve-getDistAtPoint a y)) ) )
p1 (car l)
p2 (cadr l)
d1 (vlax-curve-getDistAtPoint a p1)
d2 (vlax-curve-getDistAtPoint a p2)
i -1
l nil
)
(while (< (setq pr (+ (* (setq i (1+ i)) d) d1)) d2)
(setq l (cons (vlax-curve-getPointAtDist a pr) l))
)
(setq l (reverse l))
(setvar "osmode" 0)
(princ "\n")
(setq aa (grread))
(cond
((= (cadr aa) 49) (setq f 1) )
((= (cadr aa) 50) (setq f 2) )
((= (cadr aa) 51) (setq f 3) )
)
(mapcar '(lambda(x)
(setq an (HH:PtFirstAngle a x) q (mat:rotation x an) e (mkarc x w f))
(vla-transformby (vlax-ename->vla-object e) (vlax-tmatrix q))
) l)
(mapcar 'setvar '("cmdecho" "osmode") odlst)
)
页:
[1]