Topic: question about region offset

[Tsec2nd]

I am not sure I can express the questin clearly because of my poor english. So please see the attached file ,maybe you can understand what I mean.

I need you help to offset diffrent regions.The out loops offset towards outside,the innerloop offset towards inside and the regions which only have one loop offset towards inside.

It would be grateful for any idea.

[ribarm]

It is easier to do it manually... Do you want to offset every exploded region and therefore created polylines by the same amount of offset distance inside/outside? One more thing, why do you need this if I may ask? It looks to me like masochistic task for programming and resulting effect is minor unless something more concrete is an issue...

[Tsec2nd]

Yes,I want offset every exploded region by the same distance in diffrent direction(outside or inside). It is used
under specified conditions.

[ribarm]

OK... Here you are, but next time you are on your own...

Code - Auto/Visual Lisp: [Select]

1. (defun c:complexregoff ( / *adoc* reg minbb maxbb d el 3dsl regl )
2.  
3.   (vl-load-com)
4.  
5.   (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))
6.   (if (= 8 (logand 8 (getvar 'undoctl)))
7.     (vla-endundomark *adoc*)
8.   )
9.   (vla-startundomark *adoc*)
10.   (while
11.     (or
12.       (not (setq reg (car (entsel "\nPick complex region to do alternative offset inside - smaller areas..."))))
13.       (if reg
14.         (or
15.           (/= (cdr (assoc 0 (entget reg))) "REGION")
16.           (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget reg))))))))
17.         )
18.       )
19.     )
20.     (prompt "\nMissed or picked wrong entity type, or picked region entity on locked layer...")
21.   )
22.   (vla-getboundingbox (vlax-ename->vla-object reg) 'minbb 'maxbb)
23.   (mapcar 'set '(minbb maxbb) (mapcar 'safearray-value (list minbb maxbb)))
24.   (if (not (and (equal (caddr minbb) 0.0 1e-6) (equal (caddr maxbb) 0.0 1e-6)))
25.     (progn
26.       (prompt "\nPicked region entity don't lie in WCS. Place reference region entity in WCS plane and restart routine next time...")
27.       (exit)
28.     )
29.   )
30.   (initget 7)
31.   (setq d (getdist "\nPick or specify offset distance : "))
32.   (if (/= (getvar 'worlducs) 1)
33.     (progn
34.       (prompt "\nSet UCS to WCS and restart routine next time...")
35.       (exit)
36.     )
37.     (vl-cmdf "_.UCS" "_M" "_non" (list 0.0 0.0 d))
38.   )
39.   (setq el (entlast))
40.   (vl-cmdf "_.EXTRUDE" reg "" (* d 3.0))
41.   (while (< 0 (getvar 'cmdactive))
42.     (vl-cmdf "")
43.   )
44.   (while (setq el (entnext el))
45.     (setq 3dsl (cons el 3dsl))
46.   )
47.   (foreach 3ds 3dsl
48.     (vl-cmdf "_.SOLIDEDIT" "_B" "_S" 3ds "" d)
49.     (while (< 0 (getvar 'cmdactive))
50.       (vl-cmdf "")
51.     )
52.     (setq el (entlast))
53.     (vl-cmdf "_.EXPLODE" 3ds)
54.     (while (< 0 (getvar 'cmdactive))
55.       (vl-cmdf "")
56.     )
57.     (while (setq el (entnext el))
58.       (setq regl (cons el regl))
59.     )
60.     (foreach r regl
61.       (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-centroid (list (vlax-ename->vla-object r)))))
62.         (vla-move (vlax-ename->vla-object r) (vlax-3d-point (list 0.0 0.0 d)) (vlax-3d-point '(0.0 0.0 0.0)))
63.         (entdel r)
64.       )
65.     )
66.     (setq regl nil)
67.   )
68.   (vl-cmdf "_.UCS" "_P")
69.   (vla-endundomark *adoc*)
70.   (princ)
71. )
72.  

Regards, M.R.

[ribarm]

You haven't asked for it, but if you need opposite offsets it is slightly different... Plus you must have A2012+ (CONVTOSURFACE command and THICKEN command)...

Code - Auto/Visual Lisp: [Select]

1. (defun c:complexregoff ( / *adoc* reg minbb maxbb d el 3ds 3dsl regl )
2.  
3.   (vl-load-com)
4.  
5.   (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))
6.   (if (= 8 (logand 8 (getvar 'undoctl)))
7.     (vla-endundomark *adoc*)
8.   )
9.   (vla-startundomark *adoc*)
10.   (while
11.     (or
12.       (not (setq reg (car (entsel "\nPick complex region to do alternative offset outside - bigger areas..."))))
13.       (if reg
14.         (or
15.           (/= (cdr (assoc 0 (entget reg))) "REGION")
16.           (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget reg))))))))
17.         )
18.       )
19.     )
20.     (prompt "\nMissed or picked wrong entity type, or picked region entity on locked layer...")
21.   )
22.   (vla-getboundingbox (vlax-ename->vla-object reg) 'minbb 'maxbb)
23.   (mapcar 'set '(minbb maxbb) (mapcar 'safearray-value (list minbb maxbb)))
24.   (if (not (and (equal (caddr minbb) 0.0 1e-6) (equal (caddr maxbb) 0.0 1e-6)))
25.     (progn
26.       (prompt "\nPicked region entity don't lie in WCS. Place reference region entity in WCS plane and restart routine next time...")
27.       (exit)
28.     )
29.   )
30.   (initget 7)
31.   (setq d (getdist "\nPick or specify offset distance : "))
32.   (if (/= (getvar 'worlducs) 1)
33.     (progn
34.       (prompt "\nSet UCS to WCS and restart routine next time...")
35.       (exit)
36.     )
37.     (vl-cmdf "_.UCS" "_M" "_non" (list 0.0 0.0 (- d)))
38.   )
39.   (setq el (entlast))
40.   (vl-cmdf "_.EXTRUDE" reg "" (* d 3.0))
41.   (while (< 0 (getvar 'cmdactive))
42.     (vl-cmdf "")
43.   )
44.   (while (setq el (entnext el))
45.     (setq 3dsl (cons el 3dsl))
46.   )
47.   (foreach 3ds 3dsl
48.     (vl-cmdf "_.CONVTOSURFACE" 3ds "")
49.     (vl-cmdf "_.THICKEN" (entlast) "" d)
50.     (while (< 0 (getvar 'cmdactive))
51.       (vl-cmdf "")
52.     )
53.     (setq 3ds (entlast) el 3ds)
54.     (vl-cmdf "_.EXPLODE" 3ds)
55.     (while (< 0 (getvar 'cmdactive))
56.       (vl-cmdf "")
57.     )
58.     (while (setq el (entnext el))
59.       (setq regl (cons el regl))
60.     )
61.     (foreach r regl
62.       (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-centroid (list (vlax-ename->vla-object r)))))
63.         (vla-move (vlax-ename->vla-object r) (vlax-3d-point '(0.0 0.0 0.0)) (vlax-3d-point (list 0.0 0.0 d)))
64.         (entdel r)
65.       )
66.     )
67.     (setq regl nil)
68.   )
69.   (vl-cmdf "_.UCS" "_P")
70.   (vla-endundomark *adoc*)
71.   (princ)
72. )
73.  

Regards, M.R.

[Tsec2nd]

Dear Sir, Thank you for your warmhearted help.I'll take some time to digest it because I am not familiar with 3D commands.Thanks again!

Taner

 

[ribarm]

I've hasetated to post 2 more offseting codes because of the issue I described here :
http://www.theswamp.org/index.php?topic=54245.msg588507#msg588507

But as I figured where the problem was, I am glad that now I can post (vla-offset) versions... So 2 more caases are solved : offseting complex region inside - all offsets are one way (not alternative like it was requested and solved by using 3D operations); and offseting complex region outside - also one way...

Note that those 2 codes are exactly the same, only difference is sign : (if (> ar arp) ... ) for inside and (if (< ar arp) ... ) for outside...

Regards, M.R.

[ribarm]

Code - Auto/Visual Lisp: [Select]

1. (defun c:complexregoff ( / unique car-sort chiv *adoc* reg minbb maxbb d el 3dsl regl nregl ss pll plll npll big p pl ar arp catch )
2.  
3.   (vl-load-com)
4.  
5.   (defun unique ( l )
6.     (if l
7.       (cons (car l)
8.         (unique (vl-remove (car l) l))
9.       )
10.     )
11.   )
12.  
13.   (defun car-sort ( l f / removenth r k )
14.  
15.     (defun removenth ( l n / k )
16.       (setq k -1)
17.       (vl-remove-if '(lambda ( x ) (= (setq k (1+ k)) n)) l)
18.     )
19.  
20.     (setq k -1)
21.     (vl-some '(lambda ( a ) (setq k (1+ k)) (if (vl-every '(lambda ( x ) (apply f (list a x))) (removenth l k)) (setq r a))) l)
22.     r
23.   )
24.  
25.   (defun chiv ( e p / ed edd eddd eddd1 eddd2 eddd3 newed m n i ) ; args e - ename of lwpolyline, p - new initial vertex point in WCS
26.  
27.     (vl-load-com)
28.  
29.     (setq ed (entget e))
30.     (setq edd nil)
31.     (foreach ec ed
32.       (if (not
33.             (or (eq (car ec) 10) (eq (car ec) 40) (eq (car ec) 41) (eq (car ec) 42) (eq (car ec) 91) (eq (car ec) 210))
34.           )
35.           (setq edd (cons ec edd))
36.       )
37.     )
38.     (setq edd (reverse edd))
39.     (setq eddd nil)
40.     (setq eddd1 nil)
41.     (setq eddd2 nil)
42.     (setq eddd (member (assoc 10 ed) ed))
43.     ;;;(setq p (getpoint "\nPick vertex you want to become initial"))
44.     (setq m (vlax-curve-getparamatpoint e (vlax-curve-getclosestpointto e p)))
45.     (if (assoc 91 ed) (setq n (* m 5)) (setq n (* m 4)))
46.     (setq i 0)
47.     (foreach ec eddd
48.       (progn
49.         (setq i (+ i 1))
50.         (if (<= i n)
51.           (setq eddd1 (cons ec eddd1))
52.         )
53.         (if (> i n)
54.           (setq eddd2 (cons ec eddd2))
55.         )
56.       )
57.     )
58.     (setq eddd1 (reverse eddd1))
59.     (setq eddd3 (list (assoc 210 eddd2)))
60.     (setq eddd2 (cdr eddd2))
61.     (setq eddd2 (reverse eddd2))
62.     (setq newed (append edd eddd2 eddd1 eddd3))
63.     (entmod newed)
64.     (entupd e)
65.   )
66.  
67.   (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))
68.   (if (= 8 (logand 8 (getvar 'undoctl)))
69.     (vla-endundomark *adoc*)
70.   )
71.   (vla-startundomark *adoc*)
72.   (while
73.     (or
74.       (not (setq reg (car (entsel "\nPick complex region to do one-way offset inside..."))))
75.       (if reg
76.         (or
77.           (/= (cdr (assoc 0 (entget reg))) "REGION")
78.           (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget reg))))))))
79.         )
80.       )
81.     )
82.     (prompt "\nMissed or picked wrong entity type, or picked region entity on locked layer...")
83.   )
84.   (vla-getboundingbox (vlax-ename->vla-object reg) 'minbb 'maxbb)
85.   (mapcar 'set '(minbb maxbb) (mapcar 'safearray-value (list minbb maxbb)))
86.   (if (not (and (equal (caddr minbb) 0.0 1e-6) (equal (caddr maxbb) 0.0 1e-6)))
87.     (progn
88.       (prompt "\nPicked region entity don't lie in WCS. Place reference region entity in WCS plane and restart routine next time...")
89.       (exit)
90.     )
91.   )
92.   (initget 7)
93.   (setq d (getdist "\nPick or specify offset distance : "))
94.   (if (/= (getvar 'worlducs) 1)
95.     (progn
96.       (prompt "\nSet UCS to WCS and restart routine next time...")
97.       (exit)
98.     )
99.   )
100.   (setq el (entlast))
101.   (vl-cmdf "_.EXTRUDE" reg "" (* d 3.0))
102.   (while (< 0 (getvar 'cmdactive))
103.     (vl-cmdf "")
104.   )
105.   (while (setq el (entnext el))
106.     (setq 3dsl (cons el 3dsl))
107.   )
108.   (foreach 3ds 3dsl
109.     (setq el (entlast))
110.     (vl-cmdf "_.EXPLODE" 3ds)
111.     (while (< 0 (getvar 'cmdactive))
112.       (vl-cmdf "")
113.     )
114.     (while (setq el (entnext el))
115.       (setq regl (cons el regl))
116.     )
117.     (foreach r regl
118.       (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-centroid (list (vlax-ename->vla-object r)))))
119.         (setq nregl (cons r nregl))
120.         (entdel r)
121.       )
122.     )
123.     (foreach r nregl
124.       (setq el (entlast))
125.       (vl-cmdf "_.EXPLODE" r)
126.       (while (< 0 (getvar 'cmdactive))
127.         (vl-cmdf "")
128.       )
129.       (setq ss (ssadd))
130.       (while (setq el (entnext el))
131.         (ssadd el ss)
132.       )
133.       (setq pl (mapcar '(lambda ( x ) (vlax-curve-getstartpoint x)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
134.       (initcommandversion)
135.       (vl-cmdf "_.JOIN" ss)
136.       (while (< 0 (getvar 'cmdactive))
137.         (vl-cmdf "")
138.       )
139.       (foreach p pl
140.         (setq pll (cons (car (nentselp p)) pll))
141.       )
142.       (setq plll (unique pll))
143.       (setq pll nil)
144.       (foreach pl plll
145.         (vl-cmdf "_.REGION" pl)
146.         (while (< 0 (getvar 'cmdactive))
147.           (vl-cmdf "")
148.         )
149.         (setq ar (vla-get-area (vlax-ename->vla-object (entlast))))
150.         (vl-cmdf "_.UNDO" "1")
151.         (setq pll (cons (list ar pl) pll))
152.       )
153.       (setq pll (vl-sort pll '(lambda ( a b ) (> (car a) (car b)))))
154.       (setq pll (mapcar 'cadr pll))
155.       (foreach pl pll
156.         (setq el (entlast))
157.         (if (= (cdr (assoc 0 (entget pl))) "LWPOLYLINE")
158.           (progn
159.             (vla-getboundingbox (vlax-ename->vla-object pl) 'minbb 'maxbb)
160.             (mapcar 'set '(minbb maxbb) (mapcar 'safearray-value (list minbb maxbb)))
161.             (setq plll (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget pl)))) pl 0)) (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) (entget pl)))))
162.             (chiv pl (car-sort plll '(lambda ( a b ) (<= (distance minbb a) (distance minbb b)))))
163.             (setq catch (vl-catch-all-apply 'vla-offset (list (vlax-ename->vla-object pl) 0.001)))
164.           )
165.           (setq catch (vl-catch-all-apply 'vla-offset (list (vlax-ename->vla-object pl) 0.001)))
166.         )
167.         (if (not (vl-catch-all-error-p catch))
168.           (progn
169.             (setq ss (ssadd))
170.             (while (setq el (entnext el))
171.               (ssadd el ss)
172.             )
173.           )
174.         )
175.         (setq p (vlax-curve-getstartpoint (ssname ss 0)))
176.         (initcommandversion)
177.         (vl-cmdf "_.JOIN" ss)
178.         (while (< 0 (getvar 'cmdactive))
179.           (vl-cmdf "")
180.         )
181.         (vl-cmdf "_.REGION" (car (nentselp p)))
182.         (while (< 0 (getvar 'cmdactive))
183.           (vl-cmdf "")
184.         )
185.         (setq ar (vla-get-area (vlax-ename->vla-object (entlast))))
186.         (vl-cmdf "_.UNDO" "1")
187.         (vl-cmdf "_.REGION" pl)
188.         (while (< 0 (getvar 'cmdactive))
189.           (vl-cmdf "")
190.         )
191.         (setq arp (vla-get-area (vlax-ename->vla-object (entlast))))
192.         (vl-cmdf "_.UNDO" "1")
193.         (if (> ar arp)
194.           (progn
195.             (entdel (car (nentselp p)))
196.             (setq el (entlast))
197.             (if (= (cdr (assoc 0 (entget pl))) "LWPOLYLINE")
198.               (progn
199.                 (vla-getboundingbox (vlax-ename->vla-object pl) 'minbb 'maxbb)
200.                 (mapcar 'set '(minbb maxbb) (mapcar 'safearray-value (list minbb maxbb)))
201.                 (setq plll (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget pl)))) pl 0)) (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) (entget pl)))))
202.                 (chiv pl (car-sort plll '(lambda ( a b ) (<= (distance minbb a) (distance minbb b)))))
203.                 (setq catch (vl-catch-all-apply 'vla-offset (list (vlax-ename->vla-object pl) (- d))))
204.               )
205.               (setq catch (vl-catch-all-apply 'vla-offset (list (vlax-ename->vla-object pl) (- d))))
206.             )
207.             (if (not (vl-catch-all-error-p catch))
208.               (progn
209.                 (setq ss (ssadd))
210.                 (while (setq el (entnext el))
211.                   (ssadd el ss)
212.                 )
213.               )
214.             )
215.             (setq p (vlax-curve-getstartpoint (ssname ss 0)))
216.             (initcommandversion)
217.             (vl-cmdf "_.JOIN" ss)
218.             (while (< 0 (getvar 'cmdactive))
219.               (vl-cmdf "")
220.             )
221.           )
222.           (progn
223.             (entdel (car (nentselp p)))
224.             (setq el (entlast))
225.             (if (= (cdr (assoc 0 (entget pl))) "LWPOLYLINE")
226.               (progn
227.                 (vla-getboundingbox (vlax-ename->vla-object pl) 'minbb 'maxbb)
228.                 (mapcar 'set '(minbb maxbb) (mapcar 'safearray-value (list minbb maxbb)))
229.                 (setq plll (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget pl)))) pl 0)) (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) (entget pl)))))
230.                 (chiv pl (car-sort plll '(lambda ( a b ) (<= (distance minbb a) (distance minbb b)))))
231.                 (setq catch (vl-catch-all-apply 'vla-offset (list (vlax-ename->vla-object pl) d)))
232.               )
233.               (setq catch (vl-catch-all-apply 'vla-offset (list (vlax-ename->vla-object pl) d)))
234.             )
235.             (if (not (vl-catch-all-error-p catch))
236.               (progn
237.                 (setq ss (ssadd))
238.                 (while (setq el (entnext el))
239.                   (ssadd el ss)
240.                 )
241.               )
242.             )
243.             (setq p (vlax-curve-getstartpoint (ssname ss 0)))
244.             (initcommandversion)
245.             (vl-cmdf "_.JOIN" ss)
246.             (while (< 0 (getvar 'cmdactive))
247.               (vl-cmdf "")
248.             )
249.           )
250.         )
251.         (setq npll (cons (car (nentselp p)) npll))
252.       )
253.       (setq npll (reverse npll))
254.       (vl-cmdf "_.REGION" (car npll))
255.       (while (< 0 (getvar 'cmdactive))
256.         (vl-cmdf "")
257.       )
258.       (setq big (entlast))
259.       (foreach pl (cdr npll)
260.         (vl-cmdf "_.REGION" pl)
261.         (while (< 0 (getvar 'cmdactive))
262.           (vl-cmdf "")
263.         )
264.         (vla-boolean (vlax-ename->vla-object big) acsubtraction (vlax-ename->vla-object (entlast)))
265.       )
266.       (foreach pl pll
267.         (entdel pl)
268.       )
269.       (setq pll nil npll nil)
270.     )
271.     (setq regl nil nregl nil)
272.   )
273.   (vla-endundomark *adoc*)
274.   (princ)
275. )
276.  

[ribarm]

Code - Auto/Visual Lisp: [Select]

1. (defun c:complexregoff ( / unique car-sort chiv *adoc* reg minbb maxbb d el 3dsl regl nregl ss pll plll npll big p pl ar arp catch )
2.  
3.   (vl-load-com)
4.  
5.   (defun unique ( l )
6.     (if l
7.       (cons (car l)
8.         (unique (vl-remove (car l) l))
9.       )
10.     )
11.   )
12.  
13.   (defun car-sort ( l f / removenth r k )
14.  
15.     (defun removenth ( l n / k )
16.       (setq k -1)
17.       (vl-remove-if '(lambda ( x ) (= (setq k (1+ k)) n)) l)
18.     )
19.  
20.     (setq k -1)
21.     (vl-some '(lambda ( a ) (setq k (1+ k)) (if (vl-every '(lambda ( x ) (apply f (list a x))) (removenth l k)) (setq r a))) l)
22.     r
23.   )
24.  
25.   (defun chiv ( e p / ed edd eddd eddd1 eddd2 eddd3 newed m n i ) ; args e - ename of lwpolyline, p - new initial vertex point in WCS
26.  
27.     (vl-load-com)
28.  
29.     (setq ed (entget e))
30.     (setq edd nil)
31.     (foreach ec ed
32.       (if (not
33.             (or (eq (car ec) 10) (eq (car ec) 40) (eq (car ec) 41) (eq (car ec) 42) (eq (car ec) 91) (eq (car ec) 210))
34.           )
35.           (setq edd (cons ec edd))
36.       )
37.     )
38.     (setq edd (reverse edd))
39.     (setq eddd nil)
40.     (setq eddd1 nil)
41.     (setq eddd2 nil)
42.     (setq eddd (member (assoc 10 ed) ed))
43.     ;;;(setq p (getpoint "\nPick vertex you want to become initial"))
44.     (setq m (vlax-curve-getparamatpoint e (vlax-curve-getclosestpointto e p)))
45.     (if (assoc 91 ed) (setq n (* m 5)) (setq n (* m 4)))
46.     (setq i 0)
47.     (foreach ec eddd
48.       (progn
49.         (setq i (+ i 1))
50.         (if (<= i n)
51.           (setq eddd1 (cons ec eddd1))
52.         )
53.         (if (> i n)
54.           (setq eddd2 (cons ec eddd2))
55.         )
56.       )
57.     )
58.     (setq eddd1 (reverse eddd1))
59.     (setq eddd3 (list (assoc 210 eddd2)))
60.     (setq eddd2 (cdr eddd2))
61.     (setq eddd2 (reverse eddd2))
62.     (setq newed (append edd eddd2 eddd1 eddd3))
63.     (entmod newed)
64.     (entupd e)
65.   )
66.  
67.   (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))
68.   (if (= 8 (logand 8 (getvar 'undoctl)))
69.     (vla-endundomark *adoc*)
70.   )
71.   (vla-startundomark *adoc*)
72.   (while
73.     (or
74.       (not (setq reg (car (entsel "\nPick complex region to do one-way offset outside..."))))
75.       (if reg
76.         (or
77.           (/= (cdr (assoc 0 (entget reg))) "REGION")
78.           (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget reg))))))))
79.         )
80.       )
81.     )
82.     (prompt "\nMissed or picked wrong entity type, or picked region entity on locked layer...")
83.   )
84.   (vla-getboundingbox (vlax-ename->vla-object reg) 'minbb 'maxbb)
85.   (mapcar 'set '(minbb maxbb) (mapcar 'safearray-value (list minbb maxbb)))
86.   (if (not (and (equal (caddr minbb) 0.0 1e-6) (equal (caddr maxbb) 0.0 1e-6)))
87.     (progn
88.       (prompt "\nPicked region entity don't lie in WCS. Place reference region entity in WCS plane and restart routine next time...")
89.       (exit)
90.     )
91.   )
92.   (initget 7)
93.   (setq d (getdist "\nPick or specify offset distance : "))
94.   (if (/= (getvar 'worlducs) 1)
95.     (progn
96.       (prompt "\nSet UCS to WCS and restart routine next time...")
97.       (exit)
98.     )
99.   )
100.   (setq el (entlast))
101.   (vl-cmdf "_.EXTRUDE" reg "" (* d 3.0))
102.   (while (< 0 (getvar 'cmdactive))
103.     (vl-cmdf "")
104.   )
105.   (while (setq el (entnext el))
106.     (setq 3dsl (cons el 3dsl))
107.   )
108.   (foreach 3ds 3dsl
109.     (setq el (entlast))
110.     (vl-cmdf "_.EXPLODE" 3ds)
111.     (while (< 0 (getvar 'cmdactive))
112.       (vl-cmdf "")
113.     )
114.     (while (setq el (entnext el))
115.       (setq regl (cons el regl))
116.     )
117.     (foreach r regl
118.       (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-centroid (list (vlax-ename->vla-object r)))))
119.         (setq nregl (cons r nregl))
120.         (entdel r)
121.       )
122.     )
123.     (foreach r nregl
124.       (setq el (entlast))
125.       (vl-cmdf "_.EXPLODE" r)
126.       (while (< 0 (getvar 'cmdactive))
127.         (vl-cmdf "")
128.       )
129.       (setq ss (ssadd))
130.       (while (setq el (entnext el))
131.         (ssadd el ss)
132.       )
133.       (setq pl (mapcar '(lambda ( x ) (vlax-curve-getstartpoint x)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
134.       (initcommandversion)
135.       (vl-cmdf "_.JOIN" ss)
136.       (while (< 0 (getvar 'cmdactive))
137.         (vl-cmdf "")
138.       )
139.       (foreach p pl
140.         (setq pll (cons (car (nentselp p)) pll))
141.       )
142.       (setq plll (unique pll))
143.       (setq pll nil)
144.       (foreach pl plll
145.         (vl-cmdf "_.REGION" pl)
146.         (while (< 0 (getvar 'cmdactive))
147.           (vl-cmdf "")
148.         )
149.         (setq ar (vla-get-area (vlax-ename->vla-object (entlast))))
150.         (vl-cmdf "_.UNDO" "1")
151.         (setq pll (cons (list ar pl) pll))
152.       )
153.       (setq pll (vl-sort pll '(lambda ( a b ) (> (car a) (car b)))))
154.       (setq pll (mapcar 'cadr pll))
155.       (foreach pl pll
156.         (setq el (entlast))
157.         (if (= (cdr (assoc 0 (entget pl))) "LWPOLYLINE")
158.           (progn
159.             (vla-getboundingbox (vlax-ename->vla-object pl) 'minbb 'maxbb)
160.             (mapcar 'set '(minbb maxbb) (mapcar 'safearray-value (list minbb maxbb)))
161.             (setq plll (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget pl)))) pl 0)) (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) (entget pl)))))
162.             (chiv pl (car-sort plll '(lambda ( a b ) (<= (distance minbb a) (distance minbb b)))))
163.             (setq catch (vl-catch-all-apply 'vla-offset (list (vlax-ename->vla-object pl) 0.001)))
164.           )
165.           (setq catch (vl-catch-all-apply 'vla-offset (list (vlax-ename->vla-object pl) 0.001)))
166.         )
167.         (if (not (vl-catch-all-error-p catch))
168.           (progn
169.             (setq ss (ssadd))
170.             (while (setq el (entnext el))
171.               (ssadd el ss)
172.             )
173.           )
174.         )
175.         (setq p (vlax-curve-getstartpoint (ssname ss 0)))
176.         (initcommandversion)
177.         (vl-cmdf "_.JOIN" ss)
178.         (while (< 0 (getvar 'cmdactive))
179.           (vl-cmdf "")
180.         )
181.         (vl-cmdf "_.REGION" (car (nentselp p)))
182.         (while (< 0 (getvar 'cmdactive))
183.           (vl-cmdf "")
184.         )
185.         (setq ar (vla-get-area (vlax-ename->vla-object (entlast))))
186.         (vl-cmdf "_.UNDO" "1")
187.         (vl-cmdf "_.REGION" pl)
188.         (while (< 0 (getvar 'cmdactive))
189.           (vl-cmdf "")
190.         )
191.         (setq arp (vla-get-area (vlax-ename->vla-object (entlast))))
192.         (vl-cmdf "_.UNDO" "1")
193.         (if (< ar arp)
194.           (progn
195.             (entdel (car (nentselp p)))
196.             (setq el (entlast))
197.             (if (= (cdr (assoc 0 (entget pl))) "LWPOLYLINE")
198.               (progn
199.                 (vla-getboundingbox (vlax-ename->vla-object pl) 'minbb 'maxbb)
200.                 (mapcar 'set '(minbb maxbb) (mapcar 'safearray-value (list minbb maxbb)))
201.                 (setq plll (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget pl)))) pl 0)) (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) (entget pl)))))
202.                 (chiv pl (car-sort plll '(lambda ( a b ) (<= (distance minbb a) (distance minbb b)))))
203.                 (setq catch (vl-catch-all-apply 'vla-offset (list (vlax-ename->vla-object pl) (- d))))
204.               )
205.               (setq catch (vl-catch-all-apply 'vla-offset (list (vlax-ename->vla-object pl) (- d))))
206.             )
207.             (if (not (vl-catch-all-error-p catch))
208.               (progn
209.                 (setq ss (ssadd))
210.                 (while (setq el (entnext el))
211.                   (ssadd el ss)
212.                 )
213.               )
214.             )
215.             (setq p (vlax-curve-getstartpoint (ssname ss 0)))
216.             (initcommandversion)
217.             (vl-cmdf "_.JOIN" ss)
218.             (while (< 0 (getvar 'cmdactive))
219.               (vl-cmdf "")
220.             )
221.           )
222.           (progn
223.             (entdel (car (nentselp p)))
224.             (setq el (entlast))
225.             (if (= (cdr (assoc 0 (entget pl))) "LWPOLYLINE")
226.               (progn
227.                 (vla-getboundingbox (vlax-ename->vla-object pl) 'minbb 'maxbb)
228.                 (mapcar 'set '(minbb maxbb) (mapcar 'safearray-value (list minbb maxbb)))
229.                 (setq plll (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget pl)))) pl 0)) (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) (entget pl)))))
230.                 (chiv pl (car-sort plll '(lambda ( a b ) (<= (distance minbb a) (distance minbb b)))))
231.                 (setq catch (vl-catch-all-apply 'vla-offset (list (vlax-ename->vla-object pl) d)))
232.               )
233.               (setq catch (vl-catch-all-apply 'vla-offset (list (vlax-ename->vla-object pl) d)))
234.             )
235.             (if (not (vl-catch-all-error-p catch))
236.               (progn
237.                 (setq ss (ssadd))
238.                 (while (setq el (entnext el))
239.                   (ssadd el ss)
240.                 )
241.               )
242.             )
243.             (setq p (vlax-curve-getstartpoint (ssname ss 0)))
244.             (initcommandversion)
245.             (vl-cmdf "_.JOIN" ss)
246.             (while (< 0 (getvar 'cmdactive))
247.               (vl-cmdf "")
248.             )
249.           )
250.         )
251.         (setq npll (cons (car (nentselp p)) npll))
252.       )
253.       (setq npll (reverse npll))
254.       (vl-cmdf "_.REGION" (car npll))
255.       (while (< 0 (getvar 'cmdactive))
256.         (vl-cmdf "")
257.       )
258.       (setq big (entlast))
259.       (foreach pl (cdr npll)
260.         (vl-cmdf "_.REGION" pl)
261.         (while (< 0 (getvar 'cmdactive))
262.           (vl-cmdf "")
263.         )
264.         (vla-boolean (vlax-ename->vla-object big) acsubtraction (vlax-ename->vla-object (entlast)))
265.       )
266.       (foreach pl pll
267.         (entdel pl)
268.       )
269.       (setq pll nil npll nil)
270.     )
271.     (setq regl nil nregl nil)
272.   )
273.   (vla-endundomark *adoc*)
274.   (princ)
275. )
276.  

[ScottMC]

Q: My guess why this code won't work using my A2K is age, but in changing the "(vl-cmdf "_.JOIN" ss)" to pljoin was a not a solution and just doesnt even see the command.. Hopes are this works for the newer users as regions are useful! Makes me dig and learn.

[ssdd]

ribarm
 

[ribarm]

ribarm
 

I've changed a little all 4 posted codes...

[ahsattarian]

This works better  :

Code - Auto/Visual Lisp: [Select]

1. (defun c:a ()
2.   (setq es (entsel "\n Select Region to Offset : "))
3.   (setq or-var1 (getdist " Offset Distance : "))
4.   (initget "In Out")
5.   (setq or-var2 (getkword "\n Direction [ In / Out ] : "))
6.   (setq s (car es))
7.   (command "ucs" "object" (cadr es))
8.   (setq di or-var1)
9.   (cond ((= or-var2 "Out") (setq di (- di))))
10.   (setq en (entget s))
11.   (setq obj (vlax-ename->vla-object s))
12.   (setq la (cdr (assoc 8 en)))
13.   (cond ((= (logand 4 (cdr (assoc 70 (tblsearch "layer" la)))) 4) (command "layer" "unlock" la ""))) ;|  #lock  |;
14.   (setvar "clayer" la)
15.   (vl-cmdf "ucs" "m" "non" (list 0.0 0.0 di))
16.   (setq s1 (entlast))
17.   (vl-cmdf "extrude" s "" (* or-var1 3.0))
18.   (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
19.   (setq 3dsl nil)
20.   (while (setq s1 (entnext s1)) (setq 3dsl (cons s1 3dsl)))
21.   (setq reg (ssadd))
22.   (foreach 3ds 3dsl
23.     (setq method1 1)
24.     (cond
25.       ((= method1 1) (vl-cmdf "solidedit" "b" "s" 3ds "" di))
26.       ((= method1 2) (vl-cmdf "convtosurface" 3ds "" "thicken" "last" "" (- di)))
27.     )
28.     (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
29.     (setq s1 (entlast))
30.     (cond
31.       ((= method1 1) (vl-cmdf "explode" 3ds))
32.       ((= method1 2) (vl-cmdf "explode" "last"))
33.     )
34.     (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
35.     (setq regl nil)
36.     (while (setq s1 (entnext s1)) (setq regl (cons s1 regl)))
37.     (foreach r regl
38.       (setq obj1 (vlax-ename->vla-object r))
39.       (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-centroid (list obj1)))) ;|  #centroid  |;
40.         (progn
41.           (setq po1 (trans (list 0.0 0.0 di) 1 0))
42.           (setq po2 (trans (list 0.0 0.0 0.0) 1 0))
43.           (vla-move obj1 (vlax-3d-point po1) (vlax-3d-point po2))
44.           (ssadd r reg)
45.         )
46.         (entdel r)
47.       )
48.     )
49.   )
50.   (cond ((> (sslength reg) 1) (command "union" reg "")))
51.   (command "ucs" "world")
52.   (princ)
53. )

[ScottMC]

What is the simplest way to flip the region to get it toward the "Z+" direction. Would a "reverse" be able? Like this tool alot! and here's the var list:
   ( / en la obj s1 3ds r regl reg 3dsl es s di or-var1 po1 po2 or-var2 method1 )