;* Hexagonal Rotated Tessellations                                                         *
;* This is a fun little lisp routine to help you create your own tessellations.            *

;Basic Functions
(defun draw (plist) (entmake (append
'((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline")) (list (cons 90 (length plist)) '(70 . 0))
 (mapcar '(lambda (p) (cons 10 p)) plist)
(defun polymod (ent plist / data1 data2 i)
 (setq data1 (entget ent) i 0)
 (while (and (setq x (nth i data1)) (/= (setq n (car x)) 10)) (setq
  data2 (append data2 (list (if (= n 90) (cons 90 (length plist)) x)))
  i (1+ i)
 (entmod (append data2 (mapcar '(lambda (p) (cons 10 p)) plist)))
 (entupd ent)
(defun rotate (p0 theta plist / x y sin1 cos1)
 (setq sin1 (sin theta) cos1 (cos theta))
 (mapcar '(lambda (p) (setq x (- (car p) (car p0)) y (- (cadr p) (cadr p0)))
  (list (+ (car p0) (- (* x cos1) (* y sin1))) (+ (cadr p0) (* x sin1) (* y cos1)) 0)
 ) plist);m

;Draw Tessellation
(command "zoom" "window" '(-1 -1 0) '(1 1 0))
(setq handles nil theta 0 dtheta (* 2 (/ pi 3)))
(repeat 3 (setq p (polar '(0 0 0) theta 1) plist nil r 0)
 (while (<= r 1) (setq plist (append plist (list (polar p (+ theta dtheta) r))) r (+ r 0.1)))
 (draw plist)
 (setq handles (append handles (list (cdr (assoc 5 (entget (entlast)))))))
 (draw (rotate p dtheta plist))
 (setq handles (append handles (list (cdr (assoc 5 (entget (entlast)))))) theta (+ theta dtheta))

;Tessellation Logic
(defun tesselate (notifier reactor arg-list / handle i t1 plist)
 (setq handle (vlax-get-property notifier 'Handle) i (vl-position handle handles) t1 (= (rem i 2) 0))
 (foreach t1 (entget (handent handle))
  (if (= (car t1) 10) (setq plist (append plist (list (cdr t1)))))
 (setq reactor (nth (+ i (if t1 1 -1)) reactors))
 (vlr-remove reactor)
 (polymod (handent (nth (+ i (if t1 1 -1)) handles))
  (rotate (polar '(0 0 0) (* (/ i 2) dtheta) 1) (* (if t1 1 -1) dtheta) plist)
 (vlr-add reactor)
(setq ss (ssadd))
(setq reactors (mapcar
'(lambda (handle / ent) (setq ent (handent handle) ss (ssadd ent ss))
  (vlr-object-reactor (list (vlax-ename->vla-object ent)) "Object Reactor" '((:vlr-modified . tesselate)))
(sssetfirst nil ss)

;Useful Editting Commands
(defun getplist (ent / plist)
 (foreach t1 (entget ent) (if (= (car t1) 10) (setq plist (append plist (list (append (cdr t1) '(0.0)))))))
(defun take (xlist i1 i2); returns portion of a list
 (setq xlist (reverse xlist))
 (repeat (- (length xlist) i2 1) (setq xlist (cdr xlist)))
 (setq xlist (reverse xlist))
 (repeat i1 (setq xlist (cdr xlist)))
(defun position (x xlist / i found) (setq i 0)
 (while (and (< i (length xlist)) (not (setq found (equal (nth i xlist) x 1E-6)))) (setq i (1+ i)))
 (if found i)
(defun c:av (/ osmode t1 ent p p1 plist i); add vertex to polyline
 (setq osmode (getvar "osmode")) (setvar "osmode" 512)
 (if (setq t1 (entsel "\nSelect new vertex point: ")) (progn
  (setq ent (car t1) p (cadr t1) p1 (osnap p "endpoint") plist (getplist ent))
  (setq i (position p1 plist))
  (if (and (> i 0) (equal (angle p1 (osnap p "near")) (angle p1 (nth (1- i) plist)) 0.001)) (setq i (1- i)))
  (polymod ent (append (take plist 0 i) (list p) (take plist (1+ i) (1- (length plist)))))
 (setvar "osmode" osmode) (princ)
(defun c:rv (/ osmode t1 ent p); remove vertex from polyline
 (setq osmode (getvar "osmode")) (setvar "osmode" 1)
 (if (setq t1 (entsel "\nSelect vertex to remove: ")) (progn
  (setq ent (car t1) p (osnap (cadr t1) "endpoint"))
  (polymod ent (vl-remove-if '(lambda (x) (equal x p 1E-6)) (getplist ent)))
 (setvar "osmode" osmode) (princ)

(alert "Drag the grips to change the shape of the tessellation.\nAvoid dragging the 6 corner grips.\nType \"av\" at the command prompt to add a vertex.\nType \"rv\" at the command prompt to remove a vertex.")