Found in my old codes
this will get you started I think
;; edited 10.01.11
(defun C:symt(/ *error* ;|*debug*|; acsp adoc ang cir cp dist elp gap lineobj ln1 ln2 maxis pb pc pc1 pc2 pe1 pe2 pp pr rec resp)
(vl-load-com)
;; error trap by Doug Broad
(defun *error* (msg) ; create standard error handler
(cond ((not msg)) ; normal exit, no error
((member msg '("Function cancelled" "quit / exit abort"))) ; escape
((princ (strcat "\nError: " msg)) ; display fatal error
;(cond (*debug* (vl-bt))) ; if in debug mode, dump backtrace
))
(command "._undo" "_end")
)
(defun 2dp (p)
(list (car p) (cadr p)))
(defun 2d_varpt (p)
(vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble '(0 . 1))
(2dp p)
)
)
(command "._undo" "_begin")
(setq adoc (vla-get-activedocument
(vlax-get-acad-object))
acsp
(if (= (getvar "cvport") 1)
(vla-get-paperspace adoc)
(vla-get-modelspace adoc)
)
)
(initget 0 "Circle Slot Ellipse")
(if (not *shape*)
(setq *shape* "Circle")
)
(setq resp (cond ((getkword
(strcat "\nChoose a shape [Circle/Slot/Ellipse] <"
*shape*
"> : ")))
(*shape*)
)
)
(setq *shape* resp)
(cond
;;************************** Circle ****************************
((= resp "Circle")
(setq pc (getpoint "\nPick center of shape >>: "))
(setq cir (vla-Addcircle acsp (vlax-3d-point pc) 0.0001))
(while (and (setq pr (grread 5)) (= (car pr) 5))
(if (> (distance (cadr pr) pc) 0)
(vla-put-Radius cir (distance (cadr pr) pc)))) ;
(setq pb (vlax-curve-getClosestPointTo cir (cadr pr))
dist (vlax-curve-getdistatpoint cir pb)
gap (* (vla-get-Radius cir) 0.03)
pc1 (vlax-curve-getpointatdist cir (- dist gap))
pc2 (vlax-curve-getpointatdist cir (+ dist gap)))
(vl-cmdf "_break" (vlax-vla-object->ename cir) "_F" pc1 pc2)
(setq ln1 (vla-Addline acsp (vlax-3d-point pc1) (vlax-3d-point pb)))
(setq ln2 (vla-Addline acsp (vlax-3d-point pc2) (vlax-3d-point pb)))
(while (and (setq pr (grread 5)) (= (car pr) 5))
(if (> (distance (cadr pr) pc) 0)
(progn
(vla-put-endpoint ln1 (vlax-3d-point (cadr pr)))
(vla-put-endpoint ln2 (vlax-3d-point (cadr pr))))
))
)
;;circle
;;************************** Ellipse ****************************
((= resp "Ellipse")
(setq pe1 (getpoint "\nPick start point of axis >>: ")
pe2 (getpoint pe1 "\nPick end point of axis >>: ")
ang (angle pe1 pe2)
cp (mapcar (function (lambda (a b) (/ (+ a b) 2.))) pe1 pe2)
maxis (vlax-3d-point
(trans (polar '(0 0 0) ang (distance pe1 pe2)) 0 1)))
(setq elp (vla-Addellipse
acsp
(vlax-3d-point (trans cp 0 1))
maxis
0.8))
(while (and (setq pr (grread 5)) (= (car pr) 5))
(if (> (distance (cadr pr) cp) 0)
(progn
(setq maxis (vlax-3d-point
(trans (polar '(0 0 0) ang (distance cp (cadr pr))) 0 1)))
(vla-put-majoraxis elp maxis)
))) ;
(setq pb (vlax-curve-getClosestPointTo elp (cadr pr))
dist (vlax-curve-getdistatpoint elp pb)
gap (* (vlax-curve-getDistAtParam elp (vlax-curve-getendParam elp))
0.03)
pc1 (vlax-curve-getpointatdist elp (- dist gap))
pc2 (vlax-curve-getpointatdist elp (+ dist gap)))
(vl-cmdf "_break" (vlax-vla-object->ename elp) "_F" pc1 pc2)
(setq ln1 (vla-Addline acsp (vlax-3d-point pc1) (vlax-3d-point pb)))
(setq ln2 (vla-Addline acsp (vlax-3d-point pc2) (vlax-3d-point pb)))
(while (and (setq pr (grread 5)) (= (car pr) 5))
(if (> (distance (cadr pr) cp) 0)
(progn
(vla-put-endpoint ln1 (vlax-3d-point (cadr pr)))
(vla-put-endpoint ln2 (vlax-3d-point (cadr pr))))
))
)
;;************************** Slot ****************************
((= resp "Slot")
(setq pe1 (getpoint "\nPick start point of axis >>: ")
pe2 (getpoint pe1 "\nPick end point of axis >>: ")
ang (angle pe1 pe2)
cp (mapcar (function (lambda (a b) (/ (+ a b) 2.))) pe1 pe2)
lineobj (vlax-invoke
acsp
'addline
pe1
pe2))
(setq rec
(vlax-invoke
acsp
'addlightweightpolyline
(apply 'append
(mapcar (function (lambda (p) (list (car p) (cadr p))))
(list pe1 pe1 pe2 pe2)))))
(vla-setbulge rec 0 -1)
(vla-setbulge rec 2 -1)
(vla-put-closed rec :vlax-true)
(while
(and
(setq pp (grread 5))
(= (car pp) 5)
)
(setq dist (/ (distance (cadr pp)
(vlax-curve-getClosestPointTo lineobj (cadr pp)))
2.0)
)
(vla-put-coordinate
rec
0
(vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble '(0 . 1))
(2dp
(polar pe1 (- ang (/ pi 2)) dist))))
(vla-put-coordinate
rec
1
(vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble '(0 . 1))
(2dp
(polar pe1 (+ ang (/ pi 2)) dist))))
(vla-put-coordinate
rec
2
(2d_varpt
(polar pe2 (+ ang (/ pi 2)) dist)))
(vla-put-coordinate
rec
3
(vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble '(0 . 1))
(2dp
(polar pe2 (- ang (/ pi 2)) dist))))
)
(setq pb (vlax-curve-getClosestPointTo rec (cadr pp))
dist (vlax-curve-getdistatpoint rec pb)
gap (* (vlax-curve-getDistAtParam rec (vlax-curve-getendParam rec))
0.015)
pc1 (vlax-curve-getpointatdist rec (- dist gap))
pc2 (vlax-curve-getpointatdist rec (+ dist gap)))
(vl-cmdf "_break" (vlax-vla-object->ename rec) "_F" pc1 pc2)
(setq ln1 (vla-Addline acsp (vlax-3d-point pc1) (vlax-3d-point pb)))
(setq ln2 (vla-Addline acsp (vlax-3d-point pc2) (vlax-3d-point pb)))
(while (and (setq pp (grread 5)) (= (car pp) 5))
(if (> (distance (cadr pp) pb) 0)
(progn
(vla-put-endpoint ln1 (vlax-3d-point (cadr pp)))
(vla-put-endpoint ln2 (vlax-3d-point (cadr pp))))
))
(if lineobj
(progn (vla-delete lineobj)
(vlax-release-object lineobj)))
)
)
(*error* nil)
(princ)
)
