The picture shows a 100x100 box with 10 random lines in both horizontal and vertical directions.
All lines were broken with code from the breakall.lsp written by Charles Alan Butler and then transformed into regions with AutoCAD's "_region" command.
The area for any of the roughly 100 resulting regions must be within a range between 50 and 200 mm².
I need a function calculating all regions' areas, appending them to a list and first erasing the surrounding "100x100-box-region" always greater than 200 mm². The area list may be sorted, the min list area checked with >50 and the max list area with <200. If both conditions are met all random lines will be drawn, if not some kind of "while loop" will have to start again with a new set of random lines and finally print the number of loop calculations to the command line. Regions might be changed into polylines with e. g. "Region2Polyline" if that makes the area extraction easier.
Does anyone have an idea...
(defun LM:rand ( / a c m )
(setq m 4294967296.0
a 1664525.0
c 1013904223.0
$xn (rem (+ c (* a (cond ($xn) ((getvar 'date))))) m)
)
(/ $xn m)
); random function
(command "_pline" '(0 0) '(100 0) '(100 100) '(0 100) "_c")
(command "_explode" "l"); surrounding box
(setq bw 100); box width
(setq NoL 9); number of horizontal / vertical lines
(repeat NoL
(setq pt1 (list 0.0 (* (LM:rand) bw)))
(setq pt2 (list bw (* (LM:rand) bw)))
(command "_line" "_none" pt1 "_none" pt2 "")
); horizontal lines
(repeat NoL
(setq pt1 (list (* (LM:rand) bw) 0.0))
(setq pt2 (list (* (LM:rand) bw) bw))
(command "_line" "_none" pt1 "_none" pt2 "")
); vertical lines
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;; M A I N S U B R O U T I N E
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
(defun break_with (ss2brk ss2brkwith self / cmd intpts lst masterlist ss ssobjs
onlockedlayer ssget->vla-list list->3pair
get_interpts break_obj
)
;; ss2brk selection set to break
;; ss2brkwith selection set to use as break points
;; self when true will allow an object to break itself
;; note that plined will break at each vertex
(vl-load-com)
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;; S U B F U N C T I O N S
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
(defun onlockedlayer (ename / entlst)
(setq entlst (tblsearch "LAYER" (cdr (assoc 8 (entget ename)))))
(= 4 (logand 4 (cdr (assoc 70 entlst))))
)
(defun ssget->vla-list (ss / i ename lst)
(setq i -1)
(while (setq ename (ssname ss (setq i (1+ i))))
(setq lst (cons (vlax-ename->vla-object ename) lst))
)
lst
)
(defun list->3pair (old / new)
(while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
old (cdddr old))
)
(reverse new)
)
;;==============================================================
;; return a list of intersect points
;;==============================================================
(defun get_interpts (obj1 obj2 / iplist)
(if (not (vl-catch-all-error-p
(setq iplist (vl-catch-all-apply
'vlax-safearray->list
(list
(vlax-variant-value
(vla-intersectwith obj1 obj2 acextendnone)
))))))
iplist
)
)
;;==============================================================
;; Break entity at break points in list
;;==============================================================
(defun break_obj (ent brkptlst / brkobjlst en enttype maxparam closedobj
minparam obj obj2break p1param p2 p2param
)
(setq obj2break ent
brkobjlst (list ent)
enttype (cdr (assoc 0 (entget ent)))
)
(foreach brkpt brkptlst
;; get last entity created via break in case multiple breaks
(if brkobjlst
(progn
;; if pt not on object x, switch objects
(if (not (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj2break brkpt)))
)
(foreach obj brkobjlst ; find the one that pt is on
(if (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj brkpt)))
(setq obj2break obj) ; switch objects
)
)
)
)
)
;; Handle any objects that can not be used with the Break Command
;; using one point, gap of 0.000001 is used
(cond
((and (= "SPLINE" enttype) ; only closed splines
(vlax-curve-isclosed obj2break))
(setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
p2 (vlax-curve-getpointatparam obj2break (+ p1param 0.000001))
)
(command "._break" obj2break "_non" (trans brkpt 0 1) "_non" (trans p2 0 1))
)
((= "CIRCLE" enttype) ; break the circle
(setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
p2 (vlax-curve-getpointatparam obj2break (+ p1param 0.000001))
)
(command "._break" obj2break "_non" (trans brkpt 0 1) "_non" (trans p2 0 1))
(setq enttype "ARC")
)
((and (= "ELLIPSE" enttype) ; only closed ellipse
(vlax-curve-isclosed obj2break))
;; Break the ellipse, code borrowed from Joe Burke 6/6/2005
(setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
p2param (+ p1param 0.000001)
minparam (min p1param p2param)
maxparam (max p1param p2param)
obj (vlax-ename->vla-object obj2break)
)
(vlax-put obj 'startparameter maxparam)
(vlax-put obj 'endparameter (+ minparam (* pi 2)))
)
;;==================================
(t ; Objects that can be broken
(setq closedobj (vlax-curve-isclosed obj2break))
(command "._break" obj2break "_non" (trans brkpt 0 1) "_non" (trans brkpt 0 1))
(if (not closedobj) ; new object was created
(setq brkobjlst (cons (entlast) brkobjlst))
)
)
)
)
)
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;; S T A R T H E R E
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
(if (and ss2brk ss2brkwith)
(progn
;; CREATE a list of entity & it's break points
(foreach obj (ssget->vla-list ss2brk) ; check each object in ss2brk
(if (not (onlockedlayer (vlax-vla-object->ename obj)))
(progn
(setq lst nil)
;; check for break pts with other objects in ss2brkwith
(foreach intobj (ssget->vla-list ss2brkwith)
(if (and (or self (not (equal obj intobj)))
(setq intpts (get_interpts obj intobj))
)
(setq lst (append (list->3pair intpts) lst)) ; entity w/ break points
)
)
(if lst
(setq masterlist (cons (cons (vlax-vla-object->ename obj) lst) masterlist))
)
)
)
)
;; masterlist = ((ent brkpts)(ent brkpts)...)
(if masterlist
(foreach obj2brk masterlist
(break_obj (car obj2brk) (cdr obj2brk))
)
)
)
)
)
;;==========================================
;; Break all objects selected
;;==========================================
(command "._undo" "_begin")
(setq cmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
;; get objects to break
(if (setq ss (ssget "A" '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
(Break_with ss ss nil) ; ss2break ss2breakwith (flag nil = not to break with self)
)
(setvar "CMDECHO" cmd)
(command "._undo" "_end")
;;==========================================
;; Create Regions
;;==========================================
(command "_region" "_all" ""); create regions from lines
