Topic: offset polyline between two points

[dgpuertas]

 I need to do an offset to a polyline between two points.

I have a polyline and two points inside:


and i need another polyline offset to the original between the points:


The polyline is a 2d lwpolyline and may contain arcs
Any idea?

Thanks a lot.

Sorry about my english

[Lee Mac]

You will need to recreate the polyline section between the given points, then use the Visual LISP Offset method to offset the new polyline to both sides; here is an example by gile using a similar method.

[parktaeeun]

Code - Auto/Visual Lisp: [Select]

1. (
2. ;;---------------------`' Offset Pline p2p'`------------------------
3. ;;                                                                    
4. ;;  Author :                                                          
5. ;;      - PTE LISP co.                                                
6. ;;      - arin9916@naver.com                                          
7. ;;      - http://cafe.naver.com/ptelisp                              
8. ;;-------------------------------------------------------------------
9. ;;  Version                                                          
10. ;;    - 1.0 : Design & Created                             (12/12/27)
11. ;;    - 1.1 : ...                                                    
12. ;;-------------------------------------------------------------------
13. )
14. (defun c:aa
15.  
16.     ( / p1 p2 o oNew lst pamA pamB i
17.    
18.         _memoVar
19.         _lwpoly
20.         _matchproperty
21.         _3p->bulge
22.         _3P->center
23.         _tan
24.        
25.     )
26.    
27.     (defun _memoVar ( va f m s / v )
28.         (setq v (if (member (eval va) '(nil "")) s  (eval va)))
29.         (mapcar 'princ (list "\n" m " <" v "> : "))
30.         (set va ( f ))
31.         (if (member(eval va) '(nil "")) (set va v)) (eval va)
32.     )
33.    
34.     (defun _lwpoly ( lst cls )
35.         (vlax-ename->vla-object
36.             (entmakex
37.                 (append
38.                     (list
39.                         (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity")
40.                         (cons 100 "AcDbPolyline") (cons 90 (length lst))
41.                         (cons 70 cls)
42.                     )
43.                     (mapcar '(lambda (p) (cons 10 p))lst)
44.                 )
45.             )
46.         )
47.     )
48.  
49.     (defun _matchproperty ( obj1 obj2 lst )
50.         (foreach property lst
51.             (and
52.                 (vlax-property-available-p obj1 property)
53.                 (vlax-property-available-p obj2 property)
54.                 (vlax-put-property obj2 property (vlax-get-property obj1 property))
55.             )
56.         )
57.     )
58.  
59.     (defun _3p->bulge ( p1 p2 p3 / c )
60.        
61.         (if (and p1 p2 p3 (setq c (_3P->center p1 p2 p3)))
62.             (
63.                 (lambda ( a1 a2 a3 )
64.                     (if (or (< a1 a2 a3) (> a1 a2 a3))
65.                         (_tan (* 0.25 (- a3 a1)))
66.                         (_tan (* 0.25 (- a3 a1 pi pi)))
67.                     )
68.                 ) (angle c p1) (angle c p2) (angle c p3)
69.             ) 0.
70.         )
71.     )
72.  
73.     (defun _3P->center ( p1 p2 p3 / pt )
74.        
75.         (
76.             (lambda ( a1 a2 a3 / t1 t2 t3 t4 )
77.                 (setq t1 (polar p1 a1 (* 0.5 (distance p1 p2)))
78.                       t2 (polar p2 a2 (* 0.5 (distance p2 p3)))
79.                       t3 (polar t1 (+ a1 a3) 100)
80.                       t4 (polar t2 (+ a2 a3) 100)
81.                       pt (inters t1 t3 t2 t4 nil)
82.                 )
83.             ) (angle p1 p2) (angle p2 p3) (* 0.5 pi)
84.         ) pt
85.     )
86.  
87.     (defun _tan ( x )
88.         (if (not (equal 0. (cos x) 1e-8)) (/ (sin x) (cos x)))
89.     )
90.  
91.     (if
92.         (and
93.             (setq p1 (getpoint "\nSpecify point"))
94.             (setq p2 (getpoint "\nNext point."))
95.             (setq o  (ssget p2))
96.             (setq o  (vlax-ename->vla-object (ssname o 0)))
97.             (= (vla-get-objectname o) "AcDbPolyline")
98.         )
99.         (progn
100.        
101.             (_MemoVar '#PTE121227OffDist getdist "\nOffset Dist " 1.)
102.            
103.             (mapcar 'set '(pamA pamB)
104.                 (vl-sort
105.                     (list
106.                         (vlax-curve-getparamatpoint o (trans p1 1 0))
107.                         (vlax-curve-getparamatpoint o (trans p2 1 0))                  
108.                     ) '<
109.                 )
110.             )
111.            
112.             (while (< pamA pamB)
113.                 (setq lst  (cons pamA lst)
114.                       pamA (1+ (if (= pamA (fix pamA)) pamA (fix pamA)))
115.                 )
116.             )
117.             (if (/= pamB (car lst))
118.                 (setq lst (cons pamB lst))
119.             )
120.            
121.             (setq oNew
122.                 (_lwpoly
123.                     (mapcar
124.                         '(lambda ( pam )
125.                             (vlax-curve-getPointAtParam o pam)
126.                         ) lst
127.                     ) 0
128.                 )
129.             )
130.            
131.             (_MatchProperty o oNew '( Elevation layer color linetype lineweight))
132.            
133.             (setq i -1)
134.             (mapcar
135.                 '(lambda ( pamA pamB )
136.                     (vla-setbulge oNew (setq i (1+ i))
137.                         (_3p->bulge
138.                             (vlax-curve-getPointAtParam o pamA)
139.                             (vlax-curve-getPointAtParam o (* 0.5 (+ pamA pamB)))
140.                             (vlax-curve-getPointAtParam o pamB)
141.                         )
142.                     )
143.                 ) lst (cdr lst)  
144.             )
145.            
146.             (vlax-invoke oNew 'offset (* #PTE121227OffDist +0.5))
147.             (vlax-invoke oNew 'offset (* #PTE121227OffDist -0.5))
148.         )
149.     )(princ)
150. )(vl-load-com)
151.  

[Lee Mac]

My version



Should be compatible with LWPolylines of constant or varying width, with straight and/or arc segments, and defined in any construction plane.

[dgpuertas]

Thanks a lot
parktaeeun and leemac.
We always learn something viewing your code.

lee, fantastic ordenation code:

Code - Auto/Visual Lisp: [Select]

1. (if (> (setq m (vlax-curve-getparamatpoint pol p1))
2.        (setq n (vlax-curve-getparamatpoint pol p2)))
3.    (mapcar (function set) '(m n p1 p2) (list n m p2 p1)))

I have two routines.
first to do one polyline between two points, with lee code.

Code - Auto/Visual Lisp: [Select]

1. (defun object_lwpol_between_points (pol p1 p2 / m n e h l z x r w )
2.  
3. (setq p1 (vlax-curve-getclosestpointto pol (trans p1 1 0))
4.       p2 (vlax-curve-getclosestpointto pol (trans p2 1 0)))
5. (if (> (setq m (vlax-curve-getparamatpoint pol p1))
6.        (setq n (vlax-curve-getparamatpoint pol p2)))
7.    (mapcar (function set) '(m n p1 p2) (list n m p2 p1)))
8.   (setq e (entget pol)
9.         h (reverse (member (assoc 39 e) (reverse e)))
10.         l (LM:LWVertices e)
11.         z (assoc 210 e))
12.   (repeat (fix m) (setq l (cdr l)))
13.   (if (not (equal m (fix m) 1e-8))
14.          (setq x (car l)
15.                r (- m (fix m))
16.                w (cdr (assoc 40 x))
17.                l (cons (list
18.                          (cons  10 (trans p1 0 (cdr z)))
19.                          (cons  40 (+ w (* r (- (cdr (assoc 41 x)) w))))
20.                          (assoc 41 x)
21.                          (cons  42 (tan (* (- 1 r) (atan (cdr (assoc 42 x)))))))
22.                        (cdr l)))
23.                             )
24.   (setq l (reverse l))
25.   (repeat (+ (length l) (fix m) (- (fix n)) -1) (setq l (cdr l)))
26.   (if (not (equal n (fix n) 1e-8))
27.       (setq x (car l)
28.             r (- n (fix n))
29.             w (cdr (assoc 40 x))
30.             l (vl-list* (list  (cons 10 (trans p2 0 (cdr z)))
31.                                         (cons 40 0.0)
32.                                         (cons 41 0.0)
33.                                         (cons 42 0.0))
34.                                         (list
35.                                             (assoc 10 x)
36.                                             (assoc 40 x)
37.                                             (cons  41 (+ w (* r (- (cdr (assoc 41 x)) w))))
38.                                             (cons  42 (tan (* r (atan (cdr (assoc 42 x))))))
39.                                         )
40.                                         (cdr l)
41.                                     )
42.                                 )
43.                             )
44.  
45.   (vlax-ename->vla-object
46.         (entmakex (append (cdr h) (apply (function append) (reverse l)) (list z))))
47. )

And another, that make offset, reverse second and join the vertex:

Code - Auto/Visual Lisp: [Select]

1. (defun offset_pol_between_points (pl pt1 pt2 dist / reverse-vertex ob ob1 ob2 e h l z)
2.  
3.   (defun reverse-vertex (lista / ls)
4.   (setq ls (reverse lista))
5.   (mapcar (function (lambda (l1 l2 / b)
6.         (setq b (cadddr l2))
7.         (list (car l1) (cadr l2) (caddr l2) (cons (car b) (- (cdr b))))))
8.           ls (append (cdr ls) (list (car lista)))))
9.  
10.   (if (and (setq ob (object_lwpol_between_points pl pt1 pt2))
11.            (not (vl-catch-all-error-p (setq ob1 (vl-catch-all-apply (quote vla-offset) (list ob dist)))))
12.            (not (vl-catch-all-error-p (setq ob2 (vl-catch-all-apply (quote vla-offset) (list ob (- dist)))))))
13.            (progn
14.   (setq ob1 (car (variant->list ob1))
15.         ob2 (car (variant->list ob2))
16.         e (entget (vlax-vla-object->ename ob))
17.         h (reverse (member (assoc 39 e) (reverse e)))
18.         l (append (LM:LWVertices (entget (vlax-vla-object->ename ob1)))
19.                   (reverse-vertex (LM:LWVertices (entget (vlax-vla-object->ename ob2)))))
20.         z (assoc 210 e))
21.  
22.   (foreach o (list ob ob1 ob2) (vla-delete o))
23.   (entmakex (append (subst (cons 90 (length l)) (assoc 90 h) (cdr h)) (apply (function append) l) (list (cons 70 1)) (list z)))))
24.   )

I need other routine for reverse vertex in the second polyline "reverse-vertex" and another to convert safearray variant into a list

Code - Auto/Visual Lisp: [Select]

1. (Defun variant->list (VarX / Run Item Rtn)
2.   (setq Run T)
3.   (while Run
4.      (cond ((= (type VarX) (quote SAFEARRAY))
5.             (setq VarX (vlax-safearray->list VarX))
6.            )
7.            ((= (type VarX) (quote VARIANT))
8.             (if (member (vlax-variant-type VarX) (list 5 4 3 2))
9.               (setq VarX (vlax-variant-change-type Varx vlax-vbString))
10.             )
11.             (setq VarX (vlax-variant-value VarX))
12.            )
13.            (t (setq Run nil))
14.      )
15.   )
16.  
17.   (cond ((= (type VarX) (quote LIST))
18.           (mapcar (function variant->list) VarX)
19.         )
20.         ((null VarX) "")
21.         (t VarX)
22.   )
23.  
24. )

Works fine.

thanks a lot and sorry about my english

[ribarm]

Not quite fine... You haven't checked with LWPOLYLINE with alternative widths by segments... Here is my version that connects ends of offset plines with straight lines and keeps widths as like original pline...

[dgpuertas]

thanks a lot ribarm,

I had not tested with different widths segments

now (i think) works great.
thanks again

[Lee Mac]

Attached is my version for closing the resulting offset LWPolylines 

Again, should work with all LWPolylines of constant or varying width, with straight and/or arc segments, and defined in any construction plane.

[ribarm]

Lee, have you tried your lisp with rectangle as pline... I get strange results....

M.R.

[Lee Mac]

Lee, have you tried your lisp with rectangle as pline... I get strange results....

Thanks Marko, I hadn't accounted for the DXF 70 close flag when the program is used with closed LWPolylines.
I have now updated both posts. 

[RolandOrzabal]

this will be useful! thanks much!

[Lee Mac]

this will be useful! thanks much!

You're very welcome NOD 

[pingoo666]

Hello I have a small problem with this lisp, if the two points belong to the same curved segment, the curve of the subpoly is wrong. I try fo fix the code but i didnt manage.

Any Idea ?

[Lee Mac]

Please try the latest version published here: Offset Polyline Section.

[pingoo666]

Thanks lee mac it worked.