TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Adesu on October 23, 2007, 03:48:28 AM
-
This code as animation, if your cursor far from a circle, that circle would bigger and opposite if nearest.
; acfc is stand for Animation Circle From Cursor
; Design by : Adesu <Ade Suharna>
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Website : http://cadesu.multiply.com
; Create : 23 October 2007
; Program no.: 0667/10/2007
; Edit by :
(defun c:acfc (/ c1 dis gr p1 rad vgad vgao vgms xrad)
(vl-load-com)
(setq vgao (vlax-get-acad-object))
(setq vgad (vla-get-activedocument vgao))
(setq vgms (vla-get-modelspace vgad))
(setq p1 '(0 0 0))
(setq rad 0.5)
(setq c1 (vla-addCircle vgms (vlax-3d-point p1) rad))
(vla-put-color c1 acred)
(while
(setq gr (cadr (grread nil 7)))
(setq xrad (vlax-get c1 'radius))
(setq dis (distance p1 gr))
(if
(< dis xrad)
(vla-put-radius c1 (* dis 0.5))
) ; if
(if
(> dis xrad)
(vla-put-radius c1 (* dis 0.5))
) ; if
) ; while
) ; defun
<edit: title change by CAB>
-
Sight on the other hand... :-)
(defun test-1 (/ e g)
;;(test-1)
(setq e (entget (entmakex '((0 . "CIRCLE") (62 . 1) (10 0. 0. 0.) (40 . 10)))))
(while (and (setq g (grread nil 7)) (= 5 (car g)))
(setq e (entmod (subst (cons 40 (distance '(0. 0. 0.) (cadr g))) (assoc 40 e) e)))
) ;_ while
(princ)
)
-
return radius, do not create entities...
(defun test-2 (/ A G R)
;;(test-2)
(while (= (car (setq g (grread nil 5))) 5)
(setq r (distance '(0. 0. 0.) (trans (cadr g) 1 3))
a 0.
) ;_ setq
(redraw)
(repeat 200
(grvecs
'(1
(0.9998766324816601 -0.01570731731184392)
(0.9998766324816601 0.01570731731184392)
)
(list (list (* (cos (setq a (+ a 0.03141592653589793))) r) (- (* (sin a) r)) 0. 0)
(list (* (sin a) r) (* (cos a) r) 0. 0)
(list 0. 0. r 0.)
'(0. 0. 0. 1.)
) ;_ list
) ;_ grvecs
) ;_ repeat
) ;_ while
(princ (strcat "\n Radius = " (rtos r 2)))
(princ )
)
-
Adesu, Could you please change the thread title to explain what your code does? Thanks!