I tried another way to optimize the occupied area.
(defun clockwise ( p1 p2 p3 )
(<
(* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)))
(* (- (cadr p2) (cadr p1)) (- (car p3) (car p1)))
)
)
(defun c:imbric ( / js n ent dxf_ent lst_pt tmp_lst lst_d where lst_dir lst_pt_all minpt1 maxpt1 minpt2 maxpt2 minpt maxpt good result)
(setq js (ssget '((0 . "LWPOLYLINE") (-4 . "<AND") (-4 . "&") (70 . 1) (-4 . ">") (90 . 2) (-4 . "AND>") (-4 . "<NOT") (-4 . "<>") (42 . 0.0) (-4 . "NOT>"))) lst_pt_all nil good nil)
(cond
((and js (< (setq n (sslength js)) 3))
(setvar "CMDECHO" 0)
(repeat n
(setq
ent (ssname js (setq n (1- n)))
dxf_ent (entget ent)
lst_pt (mapcar '(lambda (x) (trans x ent 0)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent)))
tmp_lst nil
)
(if (not (clockwise (car lst_pt) (cadr lst_pt) (caddr lst_pt)))
(setq lst_pt (reverse lst_pt))
)
(if (zerop n) (setq lst_pt (reverse lst_pt)))
(setq
lst_d (mapcar 'distance lst_pt (cons (last lst_pt) lst_pt))
where (- (length lst_pt) (length (member (apply 'max lst_d) lst_d)))
)
(repeat (length lst_pt)
(setq
tmp_lst (cons (nth where lst_pt) tmp_lst)
where (if (> (1+ where) (1- (length lst_pt))) 0 (1+ where))
)
)
(setq
lst_pt tmp_lst
lst_dir (mapcar 'angle lst_pt (append (cdr lst_pt) (list (car lst_pt))))
lst_pt_all (cons (mapcar 'cons lst_pt lst_dir) lst_pt_all)
)
)
(foreach el (car lst_pt_all)
(foreach p (cadr lst_pt_all)
(command "_.move" (ssname js 1) "" "_none" (car p) "_none" (car el))
(command "_.rotate" (ssname js 1) ""
"_none" (car el)
"_reference" (car el)
(polar (car el) (cdr p) (distance (car p) (car el)))
(polar (car el) (cdr el) (distance (car p) (car el)))
)
(cond
(
(<
(length
(vlax-invoke
(vlax-ename->vla-object (ssname js 1))
'IntersectWith
(vlax-ename->vla-object (ssname js 0))
acExtendNone
)
)
7
)
(vla-GetBoundingBox (vlax-ename->vla-object (ssname js 0)) 'mnpt 'mxpt)
(setq
minpt1 (trans (safearray-value mnpt) 0 1)
maxpt1 (trans (safearray-value mxpt) 0 1)
)
(vla-GetBoundingBox (vlax-ename->vla-object (ssname js 1)) 'mnpt 'mxpt)
(setq
minpt2 (trans (safearray-value mnpt) 0 1)
maxpt2 (trans (safearray-value mxpt) 0 1)
minpt
(list
(apply 'min (mapcar 'car (list minpt1 minpt2)))
(apply 'min (mapcar 'cadr (list minpt1 minpt2)))
)
maxpt
(list
(apply 'max (mapcar 'car (list maxpt1 maxpt2)))
(apply 'max (mapcar 'cadr (list maxpt1 maxpt2)))
)
)
(setq good
(cons
(cons
(* (- (car maxpt) (car minpt)) (- (cadr maxpt) (cadr minpt)))
(cons
(list minpt maxpt)
(cons el p)
)
)
good
)
)
)
)
; (getkword "\nNext position") ; uncomment for see evolution
(command "_.u" "_.u")
)
)
(cond
(good
(setq result (cdr (assoc (apply 'min (mapcar 'car good)) good)))
(command "_.undo" "_begin")
(command "_.pline"
"_none" (caar result)
"_none" (list (caadar result) (cadaar result))
"_none" (cadar result)
"_none" (list (caaar result) (cadr (cadar result)))
"_close"
)
(setq result (cdr result))
(command "_.move" (ssname js 1) "" "_none" (cadr result) "_none" (caar result))
(command "_.rotate" (ssname js 1) ""
"_none" (caar result)
"_reference" (caar result)
(polar (caar result) (cddr result) (distance (caar result) (cadr result)))
(polar (caar result) (cdar result) (distance (caar result) (cadr result)))
)
(command "_.undo" "_end")
)
)
(setvar "CMDECHO" 1)
)
(T (princ "\nMust be select only 2 polylines!"))
)
(prin1)
)
