TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: ur_naz on June 05, 2015, 12:53:14 PM

Title: - = { Challenge } = - Extract Rooms from the floor plan
Post by: ur_naz on June 05, 2015, 12:53:14 PM

Hello, guys! You are the best programmers i know :-)
For now I'm looking for a routine to extract rooms from floor plan to a new layer. Below is that I have and that I want.

Title: Re: - = { Challenge } = - Extract Rooms from the floor plan
Post by: ChrisCarlson on June 05, 2015, 01:01:53 PM

That's not really a challenge, just a productivity saver for you. Do you have a submission for this challenge?

Title: Re: - = { Challenge } = - Extract Rooms from the floor plan
Post by: ur_naz on June 05, 2015, 03:08:00 PM

Quote from: ChrisCarlson on June 05, 2015, 01:01:53 PM

That's not really a challenge, just a productivity saver for you. Do you have a submission for this challenge?

Actually I have no idea on how to solve it, but I read many topics with non-ordinary tasks marked as 'challenge' . The main problem is that rooms are consist of lines & plines and have no closed boundary.
Sure, this routine should be useful for many people

Title: Re: - = { Challenge } = - Extract Rooms from the floor plan
Post by: dgorsman on June 05, 2015, 04:37:53 PM

The point of most of the "challenge" posts is to share an intellectual exercise the OP finds interesting, and to see the various solutions compared to their own.

So, in that vein, I would ask you to start: how would you do this manually?

Title: Re: - = { Challenge } = - Extract Rooms from the floor plan
Post by: ymg on June 05, 2015, 06:55:19 PM

ur_naz,

Not an easy one I am afraid.

Maybe knowing that doors opening tends to be standard size,
One could attempt to close the gaps in the polylines.

Opening could be found by finding the segments that are the
same length as the thickness of the walls.

Or may trying to fill rooms with square that are at least the size
of an opening.

But there are a lot of traps in there.

ymg

Title: Re: - = { Challenge } = - Extract Rooms from the floor plan
Post by: ur_naz on June 06, 2015, 09:51:55 AM

Quote from: ymg on June 05, 2015, 06:55:19 PM

ur_naz,

Not an easy one I am afraid.

Maybe knowing that doors opening tends to be standard size,
One could attempt to close the gaps in the polylines.

Opening could be found by finding the segments that are the
same length as the thickness of the walls.

Or may trying to fill rooms with square that are at least the size
of an opening.

But there are a lot of traps in there.

ymg

Yes, it is not easy and i don't even know the uerisctic search algorithm is faster then manually drawing.
Just in mind on how to deternine room conner points. this is for square rooms only. When sort conners to find rooms

Title: Re: - = { Challenge } = - Extract Rooms from the floor plan
Post by: roy_043 on June 06, 2015, 10:23:20 AM

Maybe this approach can work (untested :wink:):

• Determine the bounding box of the plan.
• Calculate a grid of points within the bounding box. The distance between the points is smaller than the smallest room (let's say 0.5m).
• Set HPGAPTOL to a size that is a little bigger than the maximum door width.
• For each grid point (try to) create a polyline using the BOUNDARY command, store the entity list and then erase the new entity.
• Process the stored entity lists: Delete duplicates and erase polylines that were drawn on top of walls (check for a segment that is smaller than 0.5m).
• Create polylines from the remaining entity lists.

EDIT: Nah, this won't work.

Title: Re: - = { Challenge } = - Extract Rooms from the floor plan
Post by: Lee Mac on June 06, 2015, 03:52:14 PM

Perhaps this thread will get you part-way there:

http://www.theswamp.org/index.php?topic=47422.0

Title: Re: - = { Challenge } = - Extract Rooms from the floor plan
Post by: ribarm on June 08, 2015, 02:00:07 PM

ur_naz, try this code... Only tested few times...

Code - Auto/Visual Lisp: [Select]

1. (defun c:wallspolys ( / *error* *adoc* ss d sss i ent le entl entl2 entl3 leent ip entln ce r r1 r2 bplst entdlst ar bpl bpl2 el )
2.  
3.   (vl-load-com)
4.  
5.   (defun *error* ( msg )
6.     (vla-endundomark *adoc*)
7.     (if msg (prompt msg))
8.     (princ)
9.   )
10.  
11.   (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))
12.   (vla-startundomark *adoc*)
13.   (prompt "\nSelect walls without columns (LINES,ARCS)...")
14.   (setq ss (ssget "_:L" '((0 . "LINE,ARC"))))
15.   (while (not ss)
16.     (prompt "\nEmpty sel.set... Please select walls without columns (LINES,ARCS) again...")
17.     (setq ss (ssget "_:L" '((0 . "LINE,ARC"))))
18.   )
19.   (initget 7)
20.   (setq d (getdist "\nPick or specify maximum width of walls - specify little larger value, but smaller than smallest wall length : "))
21.   (setq sss (ssadd))
22.   (repeat (setq i (sslength ss))
23.     (setq ent (ssname ss (setq i (1- i))))
24.     (ssadd ent sss)
25.     (if (eq (cdr (assoc 0 (entget ent))) "LINE")
26.       (progn
27.         (setq le (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)))
28.         (if (>= d le)
29.           (setq entl (cons (cons le ent) entl))
30.         )
31.       )
32.     )
33.   )
34.   (setq entl (vl-sort entl '(lambda ( a b ) (< (car a) (car b)))))
35.   (setq entl2 entl)
36.   (foreach leent1 entl
37.     (setq le (car leent1))
38.     (setq entl2 (vl-remove leent1 entl))
39.     (setq entl3 (vl-sort entl2 '(lambda ( a b ) (< (distance (vlax-curve-getpointatparam (cdr leent1) (/ (+ (vlax-curve-getstartparam (cdr leent1)) (vlax-curve-getendparam (cdr leent1))) 2.0)) (vlax-curve-getpointatparam (cdr a) (/ (+ (vlax-curve-getstartparam (cdr a)) (vlax-curve-getendparam (cdr a))) 2.0))) (distance (vlax-curve-getpointatparam (cdr leent1) (/ (+ (vlax-curve-getstartparam (cdr leent1)) (vlax-curve-getendparam (cdr leent1))) 2.0)) (vlax-curve-getpointatparam (cdr b) (/ (+ (vlax-curve-getstartparam (cdr b)) (vlax-curve-getendparam (cdr b))) 2.0)))))))
40.     (while (not (eq (length entl3) 1))
41.       (setq leent (car entl3))
42.       (setq ip (inters (vlax-curve-getstartpoint (cdr leent1)) (vlax-curve-getendpoint (cdr leent1)) (vlax-curve-getstartpoint (cdr leent)) (vlax-curve-getendpoint (cdr leent)) nil))
43.       (if
44.         (and
45.           (equal le (vlax-curve-getdistatparam (cdr leent) (vlax-curve-getendparam (cdr leent))) 1e-5)
46.           (and
47.             (eq (sslength (ssget "_F" (list (vlax-curve-getstartpoint (cdr leent1)) (vlax-curve-getstartpoint (cdr leent))))) 4)
48.             (eq (sslength (ssget "_F" (list (vlax-curve-getstartpoint (cdr leent1)) (vlax-curve-getendpoint (cdr leent))))) 4)
49.             (eq (sslength (ssget "_F" (list (vlax-curve-getendpoint (cdr leent1)) (vlax-curve-getstartpoint (cdr leent))))) 4)
50.             (eq (sslength (ssget "_F" (list (vlax-curve-getendpoint (cdr leent1)) (vlax-curve-getendpoint (cdr leent))))) 4)
51.           )
52.           (or
53.             (eq ip nil)
54.             (if ip
55.               (and
56.                 (not (equal (distance ip (vlax-curve-getstartpoint (cdr leent1))) 0.0 1e-5))
57.                 (not (equal (distance ip (vlax-curve-getendpoint (cdr leent1))) 0.0 1e-5))
58.                 (or
59.                   (equal (distance ip (vlax-curve-getstartpoint (cdr leent1))) (distance ip (vlax-curve-getstartpoint (cdr leent))) 1e-5)
60.                   (equal (distance ip (vlax-curve-getstartpoint (cdr leent1))) (distance ip (vlax-curve-getendpoint (cdr leent))) 1e-5)
61.                   (equal (distance ip (vlax-curve-getendpoint (cdr leent1))) (distance ip (vlax-curve-getstartpoint (cdr leent))) 1e-5)
62.                   (equal (distance ip (vlax-curve-getendpoint (cdr leent1))) (distance ip (vlax-curve-getendpoint (cdr leent))) 1e-5)
63.                 )
64.               )
65.             )
66.           )
67.         )
68.         (setq entl3 (list leent))
69.         (setq entl3 (cdr entl3))
70.       )
71.     )
72.     (vl-some
73.     '(lambda ( x / ce )
74.       (if
75.         (and
76.           (equal le (car x) 1e-5)
77.           (equal
78.             (distance (vlax-curve-getpointatparam (cdr leent1) (/ (+ (vlax-curve-getstartparam (cdr leent1)) (vlax-curve-getendparam (cdr leent1))) 2.0)) (vlax-curve-getpointatparam (cdr x) (/ (+ (vlax-curve-getstartparam (cdr x)) (vlax-curve-getendparam (cdr x))) 2.0)))
79.             (distance (vlax-curve-getpointatparam (cdr leent1) (/ (+ (vlax-curve-getstartparam (cdr leent1)) (vlax-curve-getendparam (cdr leent1))) 2.0)) (vlax-curve-getpointatparam (cdr (car entl3)) (/ (+ (vlax-curve-getstartparam (cdr (car entl3))) (vlax-curve-getendparam (cdr (car entl3)))) 2.0)))
80.             1e-5
81.           )
82.           (not (vl-position (cdr leent1) (apply 'append entln)))
83.           (not (vl-position (cdr x) (apply 'append entln)))
84.           (if (setq ce (inters (vlax-curve-getstartpoint (cdr leent1)) (vlax-curve-getendpoint (cdr leent1)) (vlax-curve-getstartpoint (cdr x)) (vlax-curve-getendpoint (cdr x)) nil))
85.             (and
86.               (not (ssget "_C" (polar ce (angle ce (mapcar '/ (mapcar '+ (vlax-curve-getstartpoint (cdr leent1)) (vlax-curve-getstartpoint (cdr x))) '(2.0 2.0 2.0))) (distance ce (vlax-curve-getstartpoint (cdr leent1)))) (polar ce (angle ce (mapcar '/ (mapcar '+ (vlax-curve-getstartpoint (cdr leent1)) (vlax-curve-getstartpoint (cdr x))) '(2.0 2.0 2.0))) (distance ce (vlax-curve-getstartpoint (cdr leent1))))))
87.               (not (ssget "_C" (polar ce (angle ce (mapcar '/ (mapcar '+ (vlax-curve-getstartpoint (cdr leent1)) (vlax-curve-getendpoint (cdr x))) '(2.0 2.0 2.0))) (distance ce (vlax-curve-getstartpoint (cdr leent1)))) (polar ce (angle ce (mapcar '/ (mapcar '+ (vlax-curve-getstartpoint (cdr leent1)) (vlax-curve-getendpoint (cdr x))) '(2.0 2.0 2.0))) (distance ce (vlax-curve-getstartpoint (cdr leent1))))))
88.               (not (ssget "_C" (polar ce (angle ce (mapcar '/ (mapcar '+ (vlax-curve-getendpoint (cdr leent1)) (vlax-curve-getstartpoint (cdr x))) '(2.0 2.0 2.0))) (distance ce (vlax-curve-getendpoint (cdr leent1)))) (polar ce (angle ce (mapcar '/ (mapcar '+ (vlax-curve-getstartpoint (cdr leent1)) (vlax-curve-getstartpoint (cdr x))) '(2.0 2.0 2.0))) (distance ce (vlax-curve-getendpoint (cdr leent1))))))
89.               (not (ssget "_C" (polar ce (angle ce (mapcar '/ (mapcar '+ (vlax-curve-getendpoint (cdr leent1)) (vlax-curve-getendpoint (cdr x))) '(2.0 2.0 2.0))) (distance ce (vlax-curve-getendpoint (cdr leent1)))) (polar ce (angle ce (mapcar '/ (mapcar '+ (vlax-curve-getendpoint (cdr leent1)) (vlax-curve-getendpoint (cdr x))) '(2.0 2.0 2.0))) (distance ce (vlax-curve-getendpoint (cdr leent1))))))
90.             )
91.             (and
92.               (not (ssget "_C" (mapcar '/ (mapcar '+ (vlax-curve-getstartpoint (cdr leent1)) (vlax-curve-getstartpoint (cdr x))) '(2.0 2.0 2.0)) (mapcar '/ (mapcar '+ (vlax-curve-getstartpoint (cdr leent1)) (vlax-curve-getstartpoint (cdr x))) '(2.0 2.0 2.0))))
93.               (not (ssget "_C" (mapcar '/ (mapcar '+ (vlax-curve-getstartpoint (cdr leent1)) (vlax-curve-getendpoint (cdr x))) '(2.0 2.0 2.0)) (mapcar '/ (mapcar '+ (vlax-curve-getstartpoint (cdr leent1)) (vlax-curve-getendpoint (cdr x))) '(2.0 2.0 2.0))))
94.               (not (ssget "_C" (mapcar '/ (mapcar '+ (vlax-curve-getendpoint (cdr leent1)) (vlax-curve-getstartpoint (cdr x))) '(2.0 2.0 2.0)) (mapcar '/ (mapcar '+ (vlax-curve-getendpoint (cdr leent1)) (vlax-curve-getstartpoint (cdr x))) '(2.0 2.0 2.0))))
95.               (not (ssget "_C" (mapcar '/ (mapcar '+ (vlax-curve-getendpoint (cdr leent1)) (vlax-curve-getendpoint (cdr x))) '(2.0 2.0 2.0)) (mapcar '/ (mapcar '+ (vlax-curve-getendpoint (cdr leent1)) (vlax-curve-getendpoint (cdr x))) '(2.0 2.0 2.0))))
96.             )
97.           )
98.         )
99.         (setq entln (cons (list (cdr leent1) (cdr x)) entln))
100.       )
101.      ) entl2
102.     )
103.   )
104.   (foreach entpair entln
105.     (if (setq ce (inters (vlax-curve-getstartpoint (car entpair)) (vlax-curve-getendpoint (car entpair)) (vlax-curve-getstartpoint (cadr entpair)) (vlax-curve-getendpoint (cadr entpair)) nil))
106.       (progn
107.         (setq ss (ssget "_C" (vlax-curve-getstartpoint (car entpair)) (vlax-curve-getstartpoint (car entpair))))
108.         (ssdel (car entpair) ss)
109.         (setq ent (ssname ss 0))
110.         (setq r (cdr (assoc 40 (entget ent))))
111.         (setq ss (ssget "_C" (vlax-curve-getstartpoint (cadr entpair)) (vlax-curve-getstartpoint (cadr entpair))))
112.         (ssdel (cadr entpair) ss)
113.         (setq ent (ssname ss 0))
114.         (setq r1 (cdr (assoc 40 (entget ent))))
115.         (setq ss (ssget "_C" (vlax-curve-getendpoint (cadr entpair)) (vlax-curve-getendpoint (cadr entpair))))
116.         (ssdel (cadr entpair) ss)
117.         (setq ent (ssname ss 0))
118.         (setq r2 (cdr (assoc 40 (entget ent))))
119.         (if (equal r r1 1e-5)
120.           (progn
121.             (command "_.ARC" "_non" (vlax-curve-getstartpoint (car entpair)) "_non" (polar ce (angle ce (mapcar '/ (mapcar '+ (vlax-curve-getstartpoint (car entpair)) (vlax-curve-getstartpoint (cadr entpair))) '(2.0 2.0 2.0))) r) "_non" (vlax-curve-getstartpoint (cadr entpair)))
122.             (setq bplst (cons (if (> r2 r1) (polar ce (angle ce (mapcar '/ (mapcar '+ (vlax-curve-getstartpoint (car entpair)) (vlax-curve-getstartpoint (cadr entpair))) '(2.0 2.0 2.0))) (- r (distance (vlax-curve-getpointatparam (car entpair) (/ (+ (vlax-curve-getstartparam (car entpair)) (vlax-curve-getendparam (car entpair))) 2.0)) (vlax-curve-getstartpoint (car entpair))))) (polar ce (angle ce (mapcar '/ (mapcar '+ (vlax-curve-getstartpoint (car entpair)) (vlax-curve-getstartpoint (cadr entpair))) '(2.0 2.0 2.0))) (+ r (distance (vlax-curve-getpointatparam (car entpair) (/ (+ (vlax-curve-getstartparam (car entpair)) (vlax-curve-getendparam (car entpair))) 2.0)) (vlax-curve-getstartpoint (car entpair)))))) bplst))
123.             (setq entdlst (cons (entlast) entdlst))
124.           )
125.           (progn
126.             (command "_.ARC" "_non" (vlax-curve-getstartpoint (car entpair)) "_non" (polar ce (angle ce (mapcar '/ (mapcar '+ (vlax-curve-getstartpoint (car entpair)) (vlax-curve-getendpoint (cadr entpair))) '(2.0 2.0 2.0))) r) "_non" (vlax-curve-getendpoint (cadr entpair)))
127.             (setq bplst (cons (if (< r2 r1) (polar ce (angle ce (mapcar '/ (mapcar '+ (vlax-curve-getstartpoint (car entpair)) (vlax-curve-getstartpoint (cadr entpair))) '(2.0 2.0 2.0))) (- r (distance (vlax-curve-getpointatparam (car entpair) (/ (+ (vlax-curve-getstartparam (car entpair)) (vlax-curve-getendparam (car entpair))) 2.0)) (vlax-curve-getstartpoint (car entpair))))) (polar ce (angle ce (mapcar '/ (mapcar '+ (vlax-curve-getstartpoint (car entpair)) (vlax-curve-getstartpoint (cadr entpair))) '(2.0 2.0 2.0))) (+ r (distance (vlax-curve-getpointatparam (car entpair) (/ (+ (vlax-curve-getstartparam (car entpair)) (vlax-curve-getendparam (car entpair))) 2.0)) (vlax-curve-getstartpoint (car entpair)))))) bplst))
128.             (setq entdlst (cons (entlast) entdlst))
129.           )
130.         )
131.         (setq ss (ssget "_C" (vlax-curve-getendpoint (car entpair)) (vlax-curve-getendpoint (car entpair))))
132.         (ssdel (car entpair) ss)
133.         (setq ent (ssname ss 0))
134.         (setq r (cdr (assoc 40 (entget ent))))
135.         (setq ss (ssget "_C" (vlax-curve-getstartpoint (cadr entpair)) (vlax-curve-getstartpoint (cadr entpair))))
136.         (ssdel (cadr entpair) ss)
137.         (setq ent (ssname ss 0))
138.         (setq r1 (cdr (assoc 40 (entget ent))))
139.         (setq ss (ssget "_C" (vlax-curve-getendpoint (cadr entpair)) (vlax-curve-getendpoint (cadr entpair))))
140.         (ssdel (cadr entpair) ss)
141.         (setq ent (ssname ss 0))
142.         (setq r2 (cdr (assoc 40 (entget ent))))
143.         (if (equal r r1 1e-5)
144.           (progn
145.             (command "_.ARC" "_non" (vlax-curve-getendpoint (car entpair)) "_non" (polar ce (angle ce (mapcar '/ (mapcar '+ (vlax-curve-getendpoint (car entpair)) (vlax-curve-getstartpoint (cadr entpair))) '(2.0 2.0 2.0))) r) "_non" (vlax-curve-getstartpoint (cadr entpair)))
146.             (setq bplst (cons (if (> r2 r1) (polar ce (angle ce (mapcar '/ (mapcar '+ (vlax-curve-getstartpoint (car entpair)) (vlax-curve-getstartpoint (cadr entpair))) '(2.0 2.0 2.0))) (- r (distance (vlax-curve-getpointatparam (car entpair) (/ (+ (vlax-curve-getstartparam (car entpair)) (vlax-curve-getendparam (car entpair))) 2.0)) (vlax-curve-getstartpoint (car entpair))))) (polar ce (angle ce (mapcar '/ (mapcar '+ (vlax-curve-getstartpoint (car entpair)) (vlax-curve-getstartpoint (cadr entpair))) '(2.0 2.0 2.0))) (+ r (distance (vlax-curve-getpointatparam (car entpair) (/ (+ (vlax-curve-getstartparam (car entpair)) (vlax-curve-getendparam (car entpair))) 2.0)) (vlax-curve-getstartpoint (car entpair)))))) bplst))
147.             (setq entdlst (cons (entlast) entdlst))
148.           )
149.           (progn
150.             (command "_.ARC" "_non" (vlax-curve-getendpoint (car entpair)) "_non" (polar ce (angle ce (mapcar '/ (mapcar '+ (vlax-curve-getendpoint (car entpair)) (vlax-curve-getendpoint (cadr entpair))) '(2.0 2.0 2.0))) r) "_non" (vlax-curve-getendpoint (cadr entpair)))
151.             (setq bplst (cons (if (< r2 r1) (polar ce (angle ce (mapcar '/ (mapcar '+ (vlax-curve-getstartpoint (car entpair)) (vlax-curve-getstartpoint (cadr entpair))) '(2.0 2.0 2.0))) (- r (distance (vlax-curve-getpointatparam (car entpair) (/ (+ (vlax-curve-getstartparam (car entpair)) (vlax-curve-getendparam (car entpair))) 2.0)) (vlax-curve-getstartpoint (car entpair))))) (polar ce (angle ce (mapcar '/ (mapcar '+ (vlax-curve-getstartpoint (car entpair)) (vlax-curve-getstartpoint (cadr entpair))) '(2.0 2.0 2.0))) (+ r (distance (vlax-curve-getpointatparam (car entpair) (/ (+ (vlax-curve-getstartparam (car entpair)) (vlax-curve-getendparam (car entpair))) 2.0)) (vlax-curve-getstartpoint (car entpair)))))) bplst))
152.             (setq entdlst (cons (entlast) entdlst))
153.           )
154.         )
155.       )
156.       (if
157.         (and
158.           (eq (sslength (ssget "_F" (list (vlax-curve-getstartpoint (car entpair)) (vlax-curve-getstartpoint (cadr entpair))))) 4)
159.           (eq (sslength (ssget "_F" (list (vlax-curve-getstartpoint (car entpair)) (vlax-curve-getendpoint (cadr entpair))))) 4)
160.           (eq (sslength (ssget "_F" (list (vlax-curve-getendpoint (car entpair)) (vlax-curve-getstartpoint (cadr entpair))))) 4)
161.           (eq (sslength (ssget "_F" (list (vlax-curve-getendpoint (car entpair)) (vlax-curve-getendpoint (cadr entpair))))) 4)
162.         )
163.         (progn
164.           (if
165.             (< (distance (vlax-curve-getstartpoint (car entpair)) (vlax-curve-getstartpoint (cadr entpair)))
166.                (distance (vlax-curve-getstartpoint (car entpair)) (vlax-curve-getendpoint (cadr entpair)))
167.             )
168.             (progn
169.               (command "_.LINE" "_non" (vlax-curve-getstartpoint (car entpair)) "_non" (vlax-curve-getstartpoint (cadr entpair)) "")
170.               (setq bplst (cons (mapcar '+ (mapcar '/ (mapcar '+ (vlax-curve-getstartpoint (car entpair)) (vlax-curve-getstartpoint (cadr entpair))) '(2.0 2.0 2.0)) (mapcar '- (mapcar '/ (mapcar '+ (vlax-curve-getstartpoint (car entpair)) (vlax-curve-getstartpoint (cadr entpair))) '(2.0 2.0 2.0)) (mapcar '/ (mapcar '+ (vlax-curve-getstartpoint (car entpair)) (vlax-curve-getendpoint (cadr entpair))) '(2.0 2.0 2.0)))) bplst))
171.               (setq entdlst (cons (entlast) entdlst))
172.             )
173.             (progn
174.               (command "_.LINE" "_non" (vlax-curve-getstartpoint (car entpair)) "_non" (vlax-curve-getendpoint (cadr entpair)) "")
175.               (setq bplst (cons (mapcar '+ (mapcar '/ (mapcar '+ (vlax-curve-getstartpoint (car entpair)) (vlax-curve-getendpoint (cadr entpair))) '(2.0 2.0 2.0)) (mapcar '- (mapcar '/ (mapcar '+ (vlax-curve-getstartpoint (car entpair)) (vlax-curve-getendpoint (cadr entpair))) '(2.0 2.0 2.0)) (mapcar '/ (mapcar '+ (vlax-curve-getstartpoint (car entpair)) (vlax-curve-getstartpoint (cadr entpair))) '(2.0 2.0 2.0)))) bplst))
176.               (setq entdlst (cons (entlast) entdlst))
177.             )
178.           )
179.           (if
180.             (< (distance (vlax-curve-getendpoint (car entpair)) (vlax-curve-getstartpoint (cadr entpair)))
181.                (distance (vlax-curve-getendpoint (car entpair)) (vlax-curve-getendpoint (cadr entpair)))
182.             )
183.             (progn
184.               (command "_.LINE" "_non" (vlax-curve-getendpoint (car entpair)) "_non" (vlax-curve-getstartpoint (cadr entpair)) "")
185.               (setq bplst (cons (mapcar '+ (mapcar '/ (mapcar '+ (vlax-curve-getendpoint (car entpair)) (vlax-curve-getstartpoint (cadr entpair))) '(2.0 2.0 2.0)) (mapcar '- (mapcar '/ (mapcar '+ (vlax-curve-getendpoint (car entpair)) (vlax-curve-getstartpoint (cadr entpair))) '(2.0 2.0 2.0)) (mapcar '/ (mapcar '+ (vlax-curve-getendpoint (car entpair)) (vlax-curve-getendpoint (cadr entpair))) '(2.0 2.0 2.0)))) bplst))
186.               (setq entdlst (cons (entlast) entdlst))
187.             )
188.             (progn
189.               (command "_.LINE" "_non" (vlax-curve-getendpoint (car entpair)) "_non" (vlax-curve-getendpoint (cadr entpair)) "")
190.               (setq bplst (cons (mapcar '+ (mapcar '/ (mapcar '+ (vlax-curve-getendpoint (car entpair)) (vlax-curve-getendpoint (cadr entpair))) '(2.0 2.0 2.0)) (mapcar '- (mapcar '/ (mapcar '+ (vlax-curve-getendpoint (car entpair)) (vlax-curve-getendpoint (cadr entpair))) '(2.0 2.0 2.0)) (mapcar '/ (mapcar '+ (vlax-curve-getendpoint (car entpair)) (vlax-curve-getstartpoint (cadr entpair))) '(2.0 2.0 2.0)))) bplst))
191.               (setq entdlst (cons (entlast) entdlst))
192.             )
193.           )
194.         )
195.       )
196.     )
197.   )
198.   (foreach ent entdlst
199.     (ssadd ent sss)
200.   )
201.   (setq el (entlast))
202.   (foreach p bplst
203.     (command "_.-BOUNDARY" "_A" "_O" "_P" "_I" "_Y" "_B" "_N" sss "" "" "_non" p "")
204.     (while (> (getvar 'cmdactive) 0) (command ""))
205.     (if (not (eq el (entlast)))
206.       (setq bpl (cons (setq el (entlast)) bpl))
207.     )
208.   )
209.   (foreach ent entdlst
210.     (entdel ent)
211.   )
212.   (setq sss (ssadd))
213.   (setq bpl (vl-sort bpl '(lambda ( a b ) (< (vlax-curve-getarea a) (vlax-curve-getarea b)))))
214.   (setq bpl2 bpl)
215.   (foreach bp bpl
216.     (if (entget bp)
217.       (progn
218.         (setq ar (vlax-curve-getarea bp))
219.         (ssadd bp sss)
220.       )
221.     )
222.     (setq bpl2 (vl-remove bp bpl2))
223.     (foreach bp2 bpl2
224.       (if
225.         (and
226.           (entget bp2)
227.           (equal ar (vlax-curve-getarea bp2) 1e-5)
228.         )
229.         (entdel bp2)
230.       )
231.     )
232.   )
233.   (sssetfirst nil sss)
234.   (*error* nil)
235. )
236.  

HTH, M.R.

Title: Re: - = { Challenge } = - Extract Rooms from the floor plan
Post by: ur_naz on June 09, 2015, 11:58:53 AM

ribarm, thank you for your code, but it seems does nothing or maybe i do it wrong. i attached 2 examples i tried to process

Title: Re: - = { Challenge } = - Extract Rooms from the floor plan
Post by: jbuzbee on June 09, 2015, 03:27:25 PM

AutoCAD Architecture

Title: Re: - = { Challenge } = - Extract Rooms from the floor plan
Post by: ribarm on June 09, 2015, 03:55:30 PM

Quote from: ur_naz on June 09, 2015, 11:58:53 AM

ribarm, thank you for your code, but it seems does nothing or maybe i do it wrong. i attached 2 examples i tried to process

ur_naz, I've updated my code... Yes, it had some lacks... And I've modified your DWG just a little to make it correct wall to wall alignment at openings... Drawing must be 100 % correct - all adjacent edges of opening in wall must be the same length - width of wall must not be different at opening... I'll attach your DWG - also I overkilled duplicate lines...

M.R.

Title: Re: - = { Challenge } = - Extract Rooms from the floor plan
Post by: ribarm on June 09, 2015, 06:39:09 PM

Finally, I've corrected code again... Make sure you don't have overlapping entities and that your DWG is drawn correctly according to above mentioned text... I strongly suggest that you have only lines and arcs which should also be overkilled before executing routine...

Regards, M.R.

Title: Re: - = { Challenge } = - Extract Rooms from the floor plan
Post by: ribarm on June 11, 2015, 01:50:16 PM

Yes ymg, there are more traps... I've coded lisp even more... Now it has implemented Gilles (purge-pline) function for simplifying LWPOLYLINES - thanks Gilles... Also I've considered cases where rooms may have the same area values, so my above function may remove those LWPOLYLINES even if they don't actually overlap... So I've decided to implement my OVERKILL-MR inside main function (c:WALLSPOLYS) and now it should overcome this trap... It may be little slower but it's correct for now - main routine that was posted considered traps like wall length to opening the same as wall width of opening and the cases with multiple openings at the same wall close to each other like shown in posted gif... I've decided to create one more step for considering creating outer LWPOLYLINE also cleaned from added vertices from openings as in my working experiences now this version can be used for quick making of 3D walls from 2D drawing - you just have to extrude all created LWPOLYLINES and subtract outer SOLID with inside SOLID(S)... I'll attach used lisp for this - you have to create additional bounding rectangle and select both rectangle and lines and arcs you want to process... If you just want to stick with old version like my posted code I also included Gilles function and my overkill inside other lisp that is attached here - it's called - "inner walls"...

So that's all from me till now... If you find some more traps and you think it's important to mention them, please report your opinion... I or maybe someone else will be willing to try to overcome that trap...

HTH, Kr. M.R.

Title: Re: - = { Challenge } = - Extract Rooms from the floor plan
Post by: ribarm on June 14, 2015, 09:37:30 AM

Although with this my new intervention it may be too slow, but if you're planning to do this just once in a time and you don't want to clean DWG from overlaps and other entity types like POLYLINEs and you're confident that your drawing is correct - constant width of walls at openings and frozen doors and other stuff like columns, I suggest that you use my double overkill-restore all selected entities version... Duration of processing now depends of complexity of selection set - the more entities you select, the more processing lasts... But I could think of no better if you're lazy of cleaning and preparing drawing... Beside this you may want to keep original POLYLINEs and LINEs and ARCs as they are with all their properties like colors, widths and so on...

As no one haven't posted some new traps, I consider this is final for now and fixed from undesired bugs...

Kr. M.R.

Title: Re: - = { Challenge } = - Extract Rooms from the floor plan
Post by: ribarm on June 15, 2015, 10:05:37 AM

I've modified attachments a little - if drawing is big now better obtaining points at arced segments for bpoly... I couldn't modify posted code (above) as now it exceeds maximum allowed number of characters... Reply if you now find something wrong...

M.R.

Title: Re: - = { Challenge } = - Extract Rooms from the floor plan
Post by: ribarm on June 16, 2015, 05:24:52 AM

One more update of attached lisps... Sorry, I am constantly checking them and getting on lacks...
Hope that now they are OK... M.R.

Title: Re: - = { Challenge } = - Extract Rooms from the floor plan
Post by: ur_naz on June 16, 2015, 04:09:27 PM

Quote from: ribarm on June 16, 2015, 05:24:52 AM

One more update of attached lisps... Sorry, I am constantly checking them and getting on lacks...
Hope that now they are OK... M.R.

ribarm, thank you for your staff, the first version does almost that i need  :-) but the last one raise an error in bricscad

Quote

; ----- LISP : Call Stack -----
;

• ...C:WALLSPOLYS <<--

;
; ----- Error around expression -----
(CDR LEENT)
;bad argument type <NIL> ; expected SELECTIONSET at [sslength]