AutoCAD: AutoLisp Kodlarıyla Yıldız Çizme

AutoCAD'de verilen yarıçap ölçüsünde yıldız çizmek için iki farklı AutoLisp kodları aşağıdadır. Kodlar İnşaat Mühendisi Mehmet Şahin Güvercin'e aittir. Kendisine teşekkür ederiz.
Lisp Nedir? AutoLisp Nedir? AutoLisp ile Programlama Nasıl Yapılır? AutoLisp Programı Nasıl Çalıştırılır? AutoLisp Programı Nasıl Yüklenir? sorularına cevap için tıklayınız.

Yıldız çizen AutoLisp Kodu. Örnek 1

;Yıldız çizimi. Örnek 1
;Kodlama: Mehmet Şahin Güvercin
;1/1/2012

(defun c:yildiz (/ a1 a2 m1 m2 m3 m4 p0 n r p dx dy)
  (setvar "cmdecho" 0) (command "undo" "group") (vl-load-com)
  (setq a1 (* (/ 18.0 180) pi) a2 (* 4 a1) a1 (- a1 a2) n nil m nil
        m1 '(40 . 0.0) m2 '(41 . 0.0) m3 '(42 . 0.0) m4 '(91 . 0) p0 '(0 0)
        r (getreal "\n Yarıçap: "))
  (repeat 5 (setq n (append n (list (polar '(0 0) (setq a1 (+ a1 a2)) r)))))
  (entmake
    (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity")(cons 67 0)(cons 39 0.0)
    (cons 100 "AcDbPolyline") (cons 90 10) (cons 70 1)(cons 43 0.0)(cons 38 0.0)
    (cons 10 (nth 0 n)) m1 m2 m3 m4 
    (cons 10 (nth 2 n)) m1 m2 m3 m4 
    (cons 10 (nth 4 n)) m1 m2 m3 m4 
    (cons 10 (nth 1 n)) m1 m2 m3 m4 
    (cons 10 (nth 3 n)) m1 m2 m3 m4))
  (while (/= (car (setq p (grread T 1))) 3)
    (setq p (cadr p) dx (- (car p) (car p0)) dy (- (cadr p) (cadr p0)))
    (vla-transformby
      (vlax-ename->vla-object (entlast))
      (vlax-tmatrix
        (list (list 1 0 0 dx) (list 0 1 0 dy) '(0 0 1 0) '(0 0 0 1))))
    (setq p0 p) (redraw (entlast) 3))
  (redraw (entlast) 4) (command "undo" "e") (prin1)
)

Yıldız çizen AutoLisp Kodu. Örnek 2

;Yıldız çizimi. Örnek 2
;Kodlama: Mehmet Şahin Güvercin
;1/1/2012

(defun c:yildiz (/ a1 a2 m1 m2 m3 m4 p0 n m r p dx dy)
  (setvar "cmdecho" 0) (command "undo" "group") (vl-load-com)
  (setq a1 (* (/ 18.0 180) pi) a2 (* 4 a1) a1 (- a1 a2) n nil m nil
        m1 '(40 . 0.0) m2 '(41 . 0.0) m3 '(42 . 0.0) m4 '(91 . 0) p0 '(0 0)
        r (getreal "\n Yarıçap: "))
  (repeat 5 (setq n (append n (list (polar '(0 0) (setq a1 (+ a1 a2)) r)))))
  (setq m (append m (list (inters (nth 0 n) (nth 2 n) (nth 1 n) (nth 4 n))))
        m (append m (list (inters (nth 1 n) (nth 3 n) (nth 2 n) (nth 0 n))))
        m (append m (list (inters (nth 2 n) (nth 4 n) (nth 3 n) (nth 1 n))))
        m (append m (list (inters (nth 3 n) (nth 0 n) (nth 4 n) (nth 2 n))))
        m (append m (list (inters (nth 4 n) (nth 1 n) (nth 0 n) (nth 3 n)))))
  (entmake
    (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity")(cons 67 0)(cons 39 0.0)
    (cons 100 "AcDbPolyline") (cons 90 10) (cons 70 1)(cons 43 0.0)(cons 38 0.0)
    (cons 10 (nth 0 n)) m1 m2 m3 m4 (cons 10 (nth 0 m)) m1 m2 m3 m4
    (cons 10 (nth 1 n)) m1 m2 m3 m4 (cons 10 (nth 1 m)) m1 m2 m3 m4
    (cons 10 (nth 2 n)) m1 m2 m3 m4 (cons 10 (nth 2 m)) m1 m2 m3 m4
    (cons 10 (nth 3 n)) m1 m2 m3 m4 (cons 10 (nth 3 m)) m1 m2 m3 m4
    (cons 10 (nth 4 n)) m1 m2 m3 m4 (cons 10 (nth 4 m)) m1 m2 m3 m4))
  (while (/= (car (setq p (grread T 1))) 3)
    (setq p (cadr p) dx (- (car p) (car p0)) dy (- (cadr p) (cadr p0)))
    (vla-transformby
      (vlax-ename->vla-object (entlast))
      (vlax-tmatrix
        (list (list 1 0 0 dx) (list 0 1 0 dy) '(0 0 1 0) '(0 0 0 1))))
    (setq p0 p) (redraw (entlast) 3))
  (redraw (entlast) 4) (command "undo" "e") (prin1)
)