[编程交流] 分享！沿cur的弧

(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    c  0. (- 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[1-upper,2-middle,3-lower]")
(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)
)