AutoLISP: Dynamic Star

This may sound simple, but if you needed to make a star, how would you do it?

Here’s an easy way.

DSTAR <enter> to start

Specify the number of points for the start

Specify the center (similar to a circle or polygon)

Specify the radius by typing in the radius or click with the mouse. Note: will not allow for OSNAPs on this click. This is because it uses the “grread” function.

~enjoy

;;; DSTAR (gile) 2009/03/09

;;; Draws a star polygon

;;; The user specify the number of brunches, the star center and a point vertex location.

(defun c:dstar (/ *error* makestar br imax ind cen loop gr star str pt)

;;;======================== LOCAL SUB ========================;;;

;; Local *error*

(defun *error* (msg)

(or (= msg "Function cancelled")

(princ (strcat "Error: " msg))

)

(and star (entdel star) (setq star nil))

(grtext)

(princ)

)

;; Creates the pline

(defun makestar (cen ang dist br ind / n zdir lst1 lst2)

(setq n (* 2 br)

zdir (trans '(0 0 1) 1 0 T)

)

(and (= (getvar "ORTHOMODE") 1) (setq ang (OrthoRound ang)))

(repeat br

(setq

lst1

(cons

(polar cen (+ ang (/ (* (setq n (- n 2)) pi) br)) dist)

lst1

)

)

)

(repeat br

(setq lst2

(cons (inters (nth n lst1)

(nth (rem (+ n br (- ind)) br) lst1)

(nth (rem (+ n (1- ind)) br) lst1)

(nth (setq n (rem (+ n (1- br)) br)) lst1)

)

lst2

)

)

)

(entmakex

(append

(list '(0 . "LWPOLYLINE")

'(100 . "AcDbEntity")

'(100 . "AcDbPolyline")

(cons 90 (* 2 br))

'(70 . 1)

(cons 38 (caddr (trans cen 1 zdir)))

(cons 210 zdir)

)

(mapcar

(function

(lambda (pt)

(cons 10 (trans pt 1 zdir))

)

)

(apply 'append

(apply 'mapcar (cons 'list (list lst1 lst2)))

)

)

)

)

)

;;;======================== MAIN ========================;;;

(or *StarPointNumber* (setq *StarPointNumber* 5))

(if (setq br (getint (strcat "\nSpecify the number of points: <"

(itoa *StarPointNumber*)

">: "

)

)

)

(setq *StarPointNumber* br)

(setq br *StarPointNumber*)

)

(if (< 4 br)

(progn

(setq imax (fix (/ (- br 0.5) 2))

ind imax

)

(initget 1)

(setq cen (getpoint "\nSpecify the star center: ")

loop T

)

(princ "\nSpecify a point vertex (or enter circle radius): ")

;; grread loop

(while (and (setq gr (grread T 12 0)) loop)

(and star (entdel star) (setq star nil))

(cond

;; Dragging

((= 5 (car gr))

(setq ang (angle cen (cadr gr))

dist (distance cen (cadr gr))

)

(if (/= 0 dist)

(setq star (makestar cen ang dist br ind))

)

(grtext -1 (strcat "Radius: " (rtos dist)))

)

;; Picked point = ends loop

((= 3 (car gr))

(makestar cen ang dist br ind)

(setq loop nil)

(grtext)

)

;; Right click = loops through available densities

((member (car gr) '(11 25))

(setq ind (+ 2 (rem (- (1+ ind) 2) (1- imax))))

)

;; Enter = reads the command line input

((equal gr '(2 13))

(cond

;; valid distance = ends loop

((and str (setq dist (distof str)) (< 0 dist))

(makestar cen ang dist br ind)

(setq loop nil)

(grtext)

)

;; valid point = ends loop

((and str (setq pt (str->pt str)))

(makestar cen (angle cen pt) (distance cen pt) br ind)

(setq loop nil)

(grtext)

)

;; invalid input

(T

(setq str nil)

(princ "\nInvalid point or distance. Specify a point vertex (or enter circle radius): ")

)

)

)

;; F8 = toggles orthomode

((equal gr '(2 15))

(setvar "ORTHOMODE" (boole 6 1 (getvar "ORTHOMODE")))

(princ (chr 8))

(princ (chr 32))

)

;; getting and printing command line input

(T

(if (= (cadr gr) 8) ;_ backspace

(or

(and str

(/= str "")

(setq str (substr str 1 (1- (strlen str))))

(princ (chr 8))

(princ (chr 32))

)

(setq str nil)

)

(or

(and str (setq str (strcat str (chr (cadr gr)))))

(setq str (chr (cadr gr)))

)

)

(and str (princ (chr (cadr gr))))

)

)

)

)

(prompt "\nThe number of points have to be greater than 4.")

)

(princ)

)

;;;======================== SUB ROUTINES ========================;;;

;; OrthoRound

;; Returns the angle rounded to pi/2

;;

;; Argument: an angle (radians)

(defun OrthoRound (ang)

(* (/ pi 2) (fix (/ (+ (/ pi 4) ang) (/ pi 2))))

)

;; STR2PT

;; Convert a string into a 3d point (input with grread)

;;

;; Argument: a string (ex: "25,63")

;; Return: a 3d point (ex (25.0 63.0 0.0) or nil if invalid string

(defun str2pt (str)

(setq str (mapcar 'read (str2lst str ",")))

(if (and (vl-every 'numberp str)

(< 1 (length str) 4)

)

(trans str 0 0)

)

)

;; STR2LST

;; Transforms a string with separator into a list of strings

;;

;; Arguments

;; str = the string

;; sep = the separator pattern

(defun str2lst (str sep / pos)

(if (setq pos (vl-string-search sep str))

(cons (substr str 1 pos)

(str2lst (substr str (+ (strlen sep) pos 1)) sep)

)

(list str)

)

)
Advertisements

About AutoCAD Tips

This blog serves as a knowledge base for myself (and anyone else) so that I can reference tips & tricks that I have learned and also refer others to it as well. I hope that this blog helps you learn at least one tip to make your drafting/design experience better.
This entry was posted in AutoLISP, TIPS. Bookmark the permalink.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s