O-tree表示法

mahuan1279

根据O-tree表示法随机生成排版图形。
(defun c:tt()
(setvar "osmode" 0)
(setq rlst '(
(1 5.3 5.1)
(2 7.4 6.5)
(3 3.3 10.3)
(4 8.5 4.6)
(5 9.2 6.2)
(6 7.4 6.9)
(7 4.4 11.4)
(8 14.4 3.6)
(9 9.2 5.6)
))
(setq area_sum (apply '+ (mapcar '(lambda (x) (* (cadr x) (caddr x))) rlst)))
(setq n (length rlst) xmax (max (apply 'max (mapcar 'cadr rlst)) (apply 'max (mapcar 'caddr rlst))))
(defun rnd ()
  (*(rem (getvar "cputicks") 1e4) 1e-4)
)
(defun rnd_n (NN)
  (fix (* NN (rnd)))
)
(defun tfun (n)
(setq lst '(-1) i 1 flag t)
(while (and flag (< i n))
  (setq sum (apply '+ lst))
  (if (= sum 0)
      (setq lst (cons -1 lst))
          (if (= sum (- i n))
              (progn
                      (setq flag nil)
                          (repeat (- n i)
                             (setq lst (cons 1 lst))
                           )
                   )
                   (if (= (rem (rnd_n 1000) 2) 1)
                       (setq lst (cons -1 lst))
                       (setq lst (cons 1 lst))
                   )
                )
        )
        (setq i (+ i 1))
)
(mapcar '(lambda (x) (/ (1+ x) 2)) (reverse lst))
)
(defun qfun(n)
(setq vlst nil)
(repeat n
   (setq vlst (cons (rnd_n 1000) vlst))
)
(mapcar '(lambda (y) (if (= (rem (rnd_n 1000) 2) 1)  y (* -1 y))) (mapcar '1+ (vl-sort-i vlst '<)))  
)
(setq tlst (tfun (* 2 n)) qlst (qfun n) j 0 dblst (list (list 0 0 (* n xmax))) pt '(0 0))
(foreach en tlst
   (if (= en 0)
       (progn
              (setq jnum (nth j qlst))
          (setq rect_now (nth (- (abs jnum) 1) rlst))
                  (if (< jnum 0)
                      (setq newrect (list (caddr rect_now) (cadr rect_now)))
              (setq newrect (list (cadr rect_now) (caddr rect_now)))
                  )
          (setq vflst (car (vl-remove nil (mapcar '(lambda (x) (if (= (car pt)(car x)) x nil)) dblst))))
          (setq vvflst (vl-remove nil (mapcar '(lambda (x) (if (< (car x)  (+ (car pt) (car newrect))) x nil))(member vflst dblst))))
          (setq ymax (cadr (car (vl-sort vvflst '(lambda (ea eb) (> (cadr ea) (cadr eb)))))) ptlst (last vvflst))
          (if (< (+ ymax (cadr newrect)) (cadr pt))
                      (progn
                        (setq pt (list  (car pt)  (- (cadr pt) (cadr newrect))))
                (command "rectang" pt "d" (car newrect) (cadr newrect) (polar pt 0 10))
                           )
                          (progn
                            (setq pt (list (car pt) ymax))
                (command "rectang" pt "d" (car newrect) (cadr newrect) (polar pt 0 10))
                           )
                  )
          (foreach ee vvflst
                 (setq dblst (vl-remove ee dblst))
          )
         (if (= (+ (car ptlst) (cadr ptlst)) (+ (car pt) (car newrect)))
                (setq dblst (cons (list (car pt) (+ (cadr pt)(cadr newrect)) (car newrect)) dblst))
                    (setq dblst (cons (list (+ (car pt) (car newrect)) (cadr ptlst) (- (+ (car ptlst) (caddr ptlst)) (car newrect))) (cons (list (car pt) (+ (cadr pt)(cadr newrect)) (car newrect)) dblst)))
              )
                  (setq dblst (vl-sort dblst '(lambda (ea eb) (< (car ea) (car eb)))))
                  (setq pt (polar pt 0 (car newrect)))
                  (setq j (+ j 1))
           )
           (progn
              (setq vflst (car (vl-remove nil (mapcar '(lambda (x) (if (= (car pt)(+ (car x) (caddr x))) x nil))  dblst))))
                  (setq pt (list (car vflst) (cadr vflst)))
           )
   )
  )
)

mahuan1279

(defun drawrect()
(setvar "osmode" 0)
(setq ens (ssget '((0 . "LWPOLYLINE"))) n (sslength ens) i 0 vlst nil)
(while (< i n)
    (setq lst (vlax-safearray->list (vlax-variant-value (vlax-get-property (vlax-ename->vla-object (ssname ens i)) 'Coordinates))))
    (setq vlst (cons (list (abs (- (+ (car lst) (cadddr lst)) (+ (cadr lst) (caddr lst))))
                               (abs (- (+ (car lst) (last  lst)) (+ (cadr lst) (cadr (reverse lst)))))                     
                                          )
                                     vlst
                                )
        )
    (setq i (+ i 1))
)
(setq lst (vl-sort (mapcar '(lambda (x) (if (> (car x) (cadr x)) x (reverse x))) vlst) '(lambda (ea eb) (> (car ea) (car eb)))))
(setq pt '(0 0))
(foreach en lst
   (command "rectang" pt "d" (car en) (cadr en) (setq pt (polar pt (/ pi 2) (cadr en))))  
)
)
(drawrect)