AIberto Posted October 26, 2014 Share Posted October 26, 2014 Source from: 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 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) ) Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.