# TheSwamp

## Code Red => AutoLISP (Vanilla / Visual) => Topic started by: dussla on March 15, 2008, 10:03:53 AM

Title: segment offset ?
Post by: dussla on March 15, 2008, 10:03:53 AM
i thought  segment offset .
it is difficult to explain  with my poor english .
so i made a sample file.
you can see my  idea .

can you understand ?
is that routine possible ?
Title: Re: segment offset ?
Post by: gile on March 15, 2008, 01:27:57 PM
Hi,

Here's my way

EDIT: corrected a missing parent.

Code: [Select]
`;;; Polyarc-data;;; Returns a list of the center, radius and angle of a 'polyarc'.(defun polyarc-data (bu p1 p2 / ang rad cen area cg)  (setq ang (* 2 (atan bu)) rad (/ (distance p1 p2)        (* 2 (sin ang))     ) cen (polar p1    (+ (angle p1 p2) (- (/ pi 2) ang))    rad     )  )  (list cen (abs rad) ang));;; Clockwise-p;;; Returns T if p1 p2 and p3 are clockwise(defun clockwise-p (p1 p2 p3)  (< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14));;; SEG-OFF;;; Offsets a segment of polyline(defun c:seg-off (/   space   ofdist  ent   pline   normal  side   pick-pt param   p1   p2   bulge   start   end   b-data  new swid ewid )  (vl-load-com)  (or *acdoc*    (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))  )  (setq space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace *acdoc*) (vla-get-ModelSpace *acdoc*)       )  )  (or *ofdist* (setq *ofdist* 10.0))  (if (setq ofdist (getdist (strcat "\nSpecify offset distance <" (rtos *ofdist*) ">: ")        )      )    (setq *ofdist* ofdist)    (setq ofdist *ofdist*)  )  (while    (and      (setq ent (entsel "\nSelect a polyline segment: "))      (setq pline (vlax-ename->vla-object (car ent)))      (= (vla-get-ObjectName pline) "AcDbPolyline")      (setq normal (vlax-get pline 'Normal))      (setq side (trans (getpoint "\nSpecify a point on offset side: ") 1 normal )      )    )     (setq pick-pt (trans (osnap (cadr ent) "_nea") 1 0)    param   (fix (vlax-curve-getParamAtPoint pline pick-pt))    p1    (trans (vlax-curve-getPointAtParam pline param) 0 normal)    p2    (trans (vlax-curve-getPointAtParam pline (1+ param))   0   normal    )    start nil     )     (if (zerop (setq bulge (vla-getBulge pline param)))       (if (clockwise-p p1 p2 side) (setq start (polar p1 (- (angle p1 p2) (/ pi 2)) ofdist)        end   (polar p2 (- (angle p1 p2) (/ pi 2)) ofdist) ) (setq start (polar p1 (+ (angle p1 p2) (/ pi 2)) ofdist)        end   (polar p2 (+ (angle p1 p2) (/ pi 2)) ofdist) )       )       (progn (setq b-data (polyarc-data bulge p1 p2)) (if (< (cadr b-data) (distance (car b-data) side))    (setq start (polar p1 (angle (car b-data) p1) ofdist) end   (polar p2 (angle (car b-data) p2) ofdist)    )    (if (< ofdist (cadr b-data))      (setq start (polar p1 (angle p1 (car b-data)) ofdist)    end (polar p2 (angle p2 (car b-data)) ofdist)      )    ) )       )     )     (if start       (progn (setq new (vlax-invoke   space   'addLightWeightPolyline   (list (car start) (cadr start) (car end) (cadr end)) ) ) (vla-getWidth pline param 'swid 'ewid) (vla-setBulge new 0 bulge) (vla-setWidth new 0 swid ewid) (foreach prop '(Elevation Layer Linetype LinetypeGeneration LinetypeScale Lineweight Normal TrueColor )    (if (vlax-property-available-p pline prop)      (vlax-put new prop (vlax-get pline prop))    ) )       )       (princ "\nOffset distance is greater than arc radius.")     )  )  (princ))`
Title: Re: segment offset ?
Post by: dussla on March 15, 2008, 09:23:57 PM
but there is error

:-) :-) :-) :-) :-) :-)
Title: Re: segment offset ?
Post by: gile on March 16, 2008, 03:10:22 AM
Oopss !
I forgot a parent.
It may work now.
Title: Re: segment offset ?
Post by: dussla on March 16, 2008, 04:38:10 AM
thank you gile
but , pls ,could  you urgrade rountine ?
that roudine work only 1 segment
i want multi segment select offset ?

pls , see attached file ~
Title: Re: segment offset ?
Post by: gile on March 24, 2008, 07:28:39 AM
Hi,

I tried something for a multi segments offset.

EDIT: works now whatever the current UCS and the pline OCS and elevation

EDIT 2: corrected the bug shown by Evgeniy

EDIT 3: 'Highlighting' selected segments

EDIT 4: added the ability of removing a selected segment from selection by clicking it.

Code: [Select]
`;; OFSEGS -Gilles Chanteau- 2008/03/26;; Offsets the selected segments of lwpolyline;; Joined segments are offseted in a single lwpolyline;; Keeps arcs and widthes;; Works whatever the current UCS and the pline OCS and elevation(defun c:ofsegs (/ ofdist   ent      pline    normal   elevat params    points   side     closest  par      bulge p1    p2     arc_data   )  (vl-load-com)  (or *acdoc*      (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))  )  (initget 6 "Through")  (if (setq ofdist (getdist (strcat "\nSpecify offset distance or [Through] <" (if (< (getvar "OFFSETDIST") 0)    "Through"    (rtos (getvar "OFFSETDIST")) ) ">: " )        )      )    (if (= ofdist "Through")      (setvar "OFFSETDIST" -1)      (setvar "OFFSETDIST" ofdist)    )    (setq ofdist (getvar "OFFSETDIST"))  )  (if (and (setq ent (entsel "\nSelect a segment to offset: "))    (setq pline (vlax-ename->vla-object (car ent)))    (= (vla-get-ObjectName pline) "AcDbPolyline")    (setq normal (vlax-get pline 'Normal))    (setq elevat (vla-get-Elevation pline))      )    (progn      (setq params (cons (fix (vlax-curve-getParamAtPoint pline (trans (osnap (cadr ent) "_nea") 1 0)       ) ) params    )      )      (HighlightSegment pline (car params))      (while (setq ent (entsel "\nSelect next segment or <exit>: ")) (if (equal (vlax-ename->vla-object (car ent)) pline)    (progn      (setq par (fix (vlax-curve-getParamAtPoint       pline       (trans (osnap (cadr ent) "_nea") 1 0)     )        )    params (if (member par params)     (vl-remove par params)     (cons par params)     )      )      (redraw)      (foreach p params (HighlightSegment pline p))    ) )      )      (if (setq side (getpoint        (if (minusp (getvar "OFFSETDIST")) "\nSpecify through point: " "\nSpecify point on side to offset: "        )      )   ) (progn   (redraw)   (vla-StartUndoMark *acdoc*)   (setq side (ilp   (trans side 1 0)   ((lambda (p)      (trans (list (car p) (cadr p) (1+ (caddr p))) 2 0)    )     (trans side 1 2)   )   (trans (list 0 0 elevat) normal 0)   normal ) closest (vlax-curve-getClosestPointTo pline side T) par (vlax-curve-getParamAtPoint pline closest)   )   (if (minusp (getvar "OFFSETDIST"))     (setq ofdist (distance side closest))   )   (cond     ((equal closest (vlax-curve-getStartPoint pline) 1e-9)      (setq side (trans side 0 normal))     )     ((equal closest (vlax-curve-getEndPoint pline) 1e-9)      (setq par (- par 1)    side (trans side 0 normal)      )     )     ((= (fix par) par)      (setq side     (polar       (trans closest 0 normal)       ((if (clockwise-p    (trans      (vlax-curve-getPointAtParam pline (- par 0.1))      0      normal    )    (trans closest 0 normal)    (trans      (vlax-curve-getPointAtParam pline (+ par 0.1))      0      normal    ) )   +   -        ) (angle '(0 0 0)        (trans (vlax-curve-getFirstDeriv pline par)       0       normal       T        ) ) (/ pi 2)       )       ofdist     )      )     )     (T      (setq par (fix par)    side (trans side 0 normal)      )     )   )   (setq bulge (vla-getBulge pline (fix par)) p1    (trans (vlax-curve-getPointAtParam pline (fix par))      0      normal       ) p2    (trans (vlax-curve-getPointAtParam pline (1+ (fix par)))      0      normal       )   )   (if (zerop bulge)     (if (clockwise-p side p2 p1)       (setq ofdist (- ofdist))     )     (progn       (setq arc_data (PolyArc-data bulge p1 p2))       (if (minusp bulge) (if (< (cadr arc_data)        (distance (car arc_data) side)     )   (setq ofdist (- ofdist)) ) (if (< (distance (car arc_data) side)        (cadr arc_data)     )   (setq ofdist (- ofdist)) )       )     )   )   (mapcar     (function       (lambda (p) (vl-catch-all-apply 'vla-Offset (list p ofdist)) (vla-delete p)       )     )     (Copysegments pline params)   )   (vla-EndUndoMark *acdoc*) )      )    )    (princ "\nUnvalid entity.")  )  (princ));; CopySegments;; Duplicates polyline segments at the same location;; Consecutive selected segments are joined;;;; Arguments;; pline : the source polyline (vla-object);; params ; the index list of segment to be copied;;;; Return;; the list of created polylines(defun CopySegments (pline params / nor space tmp copy ret)  (vl-load-com)  (or *acdoc*      (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))  )  (setq params (vl-sort params '<) nor    (vlax-get pline 'Normal) space  (vla-ObjectIDToObject *acdoc* (vla-get-OwnerID pline))  )  (while params      (setq tmp (cons (car params) tmp)   params (cdr params)    )    (if (and (zerop (car tmp))      (= (- (vlax-curve-getEndParam pline) 1) (last params))      (equal (vlax-curve-getStartPoint pline)     (vlax-curve-getEndPoint pline)     1e-9      ) )      (progn (setq params (reverse params)       tmp    (cons (car params) tmp)       params (cdr params) ) (while (= (car params) (1- (car tmp)))   (setq tmp    (cons (car params) tmp) params (cdr params)   ) ) (setq tmp    (reverse tmp)       params (reverse params) )      )    )    (while (= (car params) (1+ (car tmp)))      (setq tmp    (cons (car params) tmp)     params (cdr params)      )    )    (setq tmp (reverse (cons (1+ (car tmp)) tmp)))    (setq      pts       (vl-remove nil   (mapcar     (function       (lambda (pa / pt) (if (setq pt (vlax-curve-getPointAtParam pline pa))   ((lambda (p)      (list (car p) (cadr p))    )     (trans pt 0 nor)   ) )       )     )     tmp   )       )    )    (setq copy    (vlax-invoke      space      'addLightWeightPolyline      (apply 'append pts)    )    )    (foreach p (cdr (reverse tmp))      (vla-setBulge copy (vl-position p tmp) (vla-getBulge pline p)      )      (vla-getWidth pline p 'swid 'ewid)      (vla-setWidth copy (vl-position p tmp) swid ewid)    )    (foreach prop '(Elevation     Layer     Linetype     LinetypeGeneration     LinetypeScale     Lineweight     Normal     Thickness     TrueColor    )      (if (vlax-property-available-p pline prop) (vlax-put copy prop (vlax-get pline prop))      )    )    (setq tmp nil   ret (cons copy ret)    )  ));;================================================================;;;; HighlightSegment;; Highlight a polyline segment;;;; Arguments;; pl : the polyline (vla-object);; par : the segment index(defun HighlightSegment (pl par / p1 p2 n lst)  (and    (setq p1 (vlax-curve-getPointAtParam pl par))    (setq p1 (trans p1 0 1))    (setq p2 (vlax-curve-getPointAtParam pl (+ par 1)))    (setq p2 (trans p2 0 1))    (if (zerop (vla-getBulge pl par))      (grvecs (list -255 p1 p2))      (progn (setq n 0) (repeat 100   (setq lst (cons (trans (vlax-curve-getPointAtParam pl (+ n par)) 0 1)   lst     ) n   (+ n 0.01)   ) ) (grvecs   (cons -255 (apply 'append (mapcar 'list lst (cdr lst)))) )      )    )  ));;================================================================;;;;; Clockwise-p;;; Returns T if p1 p2 and p3 are clockwise(defun clockwise-p (p1 p2 p3)  (< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14));;================================================================;;;;; Polyarc-data;;; Returns a list of the center, radius and angle of a 'polyarc'.(defun polyarc-data (bu p1 p2 / ang rad cen area cg)  (setq ang (* 2 (atan bu)) rad (/ (distance p1 p2)        (* 2 (sin ang))     ) cen (polar p1    (+ (angle p1 p2) (- (/ pi 2) ang))    rad     )  )  (list cen (abs rad) ang));;================================================================;;;;; VXV Returns the dot product of two vectors(defun vxv (v1 v2)  (apply '+ (mapcar '* v1 v2)));;================================================================;;;;; ILP;;; Returns the intersection point between a line (extended) and a plane;;;;;; Arguments;;; p1 and p2 : two points defining the line;;; org : a point on the plane;;; nor : the plane normal(defun ilp (p1 p2 org nor / scl)  (setq scl (/ (vxv nor (mapcar '- p1 org))        (vxv nor (mapcar '- p2 p1))     )  )  (mapcar (function (lambda (x1 x2) (+ (* scl (- x1 x2)) x1)))   p1   p2  ))`
Title: Re: segment offset ?
Post by: Serge J. Gianolla on March 24, 2008, 10:58:55 PM
Bravo Gilles,
Ca marche bien - surtout quand les elements sont contigus, ca reste pline apres un offset! J'ai meme pousse  :evil: jusqu'a avoir differentes epaisseurs et meme start and end widths differentes, ca respecte bien. Ai un souci quand meme, quand pline est fit ou spline, le message est que j'ai selectionne "Invalid entity".
Title: Re: segment offset ?
Post by: Serge J. Gianolla on March 25, 2008, 01:43:30 AM
Oops,
was thrown out of texting then it was end of lunchtime.  :-o

What I was saying was:
It works very well indeed, especially if one selects contiguous elements - still a pline after offsetting! I pushed it to limits too, with different pline widths and even making sure the start and end widths to be different and there is no loss when offset. Only issue I have is when used on a curve-fit or splined polyline. I have found out since that it affects old type of plines; not when drawing a LWPline!
Title: Re: segment offset ?
Post by: gile on March 25, 2008, 03:19:47 AM
Merci pour le retour, Serge

The routine doesn't treat 'old style' 2d polylines because they don't support the vla-getWidth function (non constant width) nor the vla-getBulge one if they're fitted or splined.
Title: Re: segment offset ?
Post by: ElpanovEvgeniy on March 25, 2008, 06:54:07 AM
Hello gile!
I liked your idea of testing of a direction! :)
Code: [Select]
`(defun clockwise-p (p1 p2 p3) (< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14))`
Title: Re: segment offset ?
Post by: ElpanovEvgeniy on March 25, 2008, 07:03:35 AM
The program not always works truly...  :-(
Title: Re: segment offset ?
Post by: dussla on March 25, 2008, 08:39:54 AM
really thank you for your effort

i found this lisp  for  segment line check  from other kind man lisp

(defun c:rseg ( / elst ename pt param preparam postparam pt1 pt2)
(setq elst (entsel "\nSelect pline segment: "))
(setq ename (car elst))
(setq pt (vlax-curve-getClosestPointTo ename pt))
(print  (setq param (vlax-curve-getParamAtPoint ename pt)) )
(print  (setq preparam (fix param)) )
(print  (setq postparam (1+ preparam)) )
(setq  pt1     (vlax-curve-getPointAtParam ename preparam) )
(setq  pt2     (vlax-curve-getPointAtParam ename postparam) )
(redraw)
(draw_pt pt1)
(draw_pt pt2)

) ;end

(defun draw_pt (pt / rap)
(setq rap (/ (getvar "viewsize") 50))
(foreach n
(mapcar '(lambda (x) (list ((eval (car x)) (car pt) rap) ((eval (cadr x)) (cadr pt) rap)))
'((+ +) (+ -) (- +) (- -))
)
(grdraw pt n -1)
)
)

like this lisp

can you modify some  , then  your lisp  will be  perpect
Title: Re: segment offset ?
Post by: gile on March 25, 2008, 01:21:33 PM
Thanks for the bug reporting Evgeniy.

I revised the code, I think it's corrected now.
Title: Re: segment offset ?
Post by: gile on March 25, 2008, 05:28:58 PM
I revised the code: 'highlighting' selected segments (doesn't work very well on arcs).
Title: Re: segment offset ?
Post by: gile on March 26, 2008, 09:54:38 AM
One more revision: a selected segment can be removed from the selection by clicking it again.
Title: Re: segment offset ?
Post by: kdub on February 19, 2009, 01:17:51 AM
gile,

Very NICE !! ..  Saved lots of time :)
Title: Re: segment offset ?
Post by: gile on February 19, 2009, 01:21:00 AM
You're welcome, Kerry.
Title: Re: segment offset ?
Post by: CAB on February 19, 2009, 08:03:33 AM
The coding is very nice and a useful routine. 8-)
Title: Re: segment offset ?
Post by: GDF on February 19, 2009, 10:01:37 AM
Hi,

Here's my way

EDIT: corrected a missing parent.

Gile

I just saw this and tried it out...VERY NICE. Thanks for sharing it. It will come in handy.

Gary
Title: Re: segment offset ?
Post by: gile on February 19, 2009, 03:04:24 PM
Thanks to all, you're welcome.

I'm glad you find it usefull.
Title: Re: segment offset ?
Post by: alanjt on February 25, 2010, 09:33:21 AM
Fantastic code, Gile; very useful. :)
Title: Re: segment offset ?
Post by: rayakmal on December 27, 2019, 02:31:56 AM
Thanks to all, you're welcome.

I'm glad you find it usefull.

My main problem is, polyline that I need to offset resides inside a block.
E.q: When I working with a MEP Drawing, I need to draw a water pipeline, offsetting a parcel line that resides inside site plan block.
Title: Re: segment offset ?
Post by: Lee Mac on December 27, 2019, 06:13:35 AM
My main problem is, polyline that I need to offset resides inside a block.

You could use NCOPY first.
Title: Re: segment offset ?
Post by: rayakmal on December 29, 2019, 08:52:42 PM
My main problem is, polyline that I need to offset resides inside a block.

You could use NCOPY first.

Wow. I didn't realize Ncopy means Nested Copy  :-)
I'm an old dog, hard to learn new tricks, I meant, when upgrading I don't really learn all new commands.
Thanks. you saved my life again.
Title: Re: segment offset ?
Post by: BIGAL on December 30, 2019, 12:39:49 AM
Would using a xref be better way than "site plan block" as you can edit the xref pretty simply.
Title: Re: segment offset ?
Post by: rayakmal on January 01, 2020, 01:40:56 PM
Would using a xref be better way than "site plan block" as you can edit the xref pretty simply.

We don't use an xref extensively. The main reason is our working folders can't be accessed freely by other divisions, when other divisions need our drawings we need to copy all the necessary drawings to a shared folder and sometimes forget to copy the xref files.
Title: Re: segment offset ?
Post by: ahsattarian on November 30, 2020, 08:19:09 AM
This Helps U  :

Code - Auto/Visual Lisp: [Select]
1. (defun c:opl ()
2.   (defun sub1 () (cond (s1 (entdel s1) (setq s1 nil))))
3.   (defun sub2 ()
4.     (redraw)
5.     (cond (s1 (entdel s1) (setq s1 nil)))
6.     (setq side (trans side 1 normal))
7.     (setq start nil)
8.     (setq bulge (vla-getbulge obj param))
9.     (if (zerop bulge)
10.         (setq ang (- (angle pt side) (angle p1 p2) (* pi 0.5)))
11.         (setq ofdist (* (abs (cos ang)) (distance pt side)))
12.         (grdraw pt side 8 1)
13.         (setq clockwise-p (< (sin (- (angle p1 side) (angle p1 p2))) -1e-14)) ;|  #clockwise  |;
14.         (if clockwise-p
15.             (setq start (polar p1 (- (angle p1 p2) (* pi 0.5)) ofdist))
16.             (setq end (polar p2 (- (angle p1 p2) (* pi 0.5)) ofdist))
17.           )
18.             (setq start (polar p1 (+ (angle p1 p2) (* pi 0.5)) ofdist))
19.             (setq end (polar p2 (+ (angle p1 p2) (* pi 0.5)) ofdist))
20.           )
21.         )
22.       )
23.         (setq ang (* (atan bulge) 2.0)) ;|  #bulge  |;
24.         (setq rad (/ (distance p1 p2) (* (sin ang) 2.0)))
25.         (setq cen (polar p1 (+ (angle p1 p2) (- (* pi 0.5) ang)) rad))
26.         (setq ofdist (abs (- (distance cen side) (abs rad))))
27.         (grdraw cen side 8 1)
28.         (if (< (abs rad) (distance cen side))
29.             (setq start (polar p1 (angle cen p1) ofdist))
30.             (setq end (polar p2 (angle cen p2) ofdist))
31.           )
32.           (if (< ofdist (abs rad))
33.               (setq start (polar p1 (angle p1 cen) ofdist))
34.               (setq end (polar p2 (angle p2 cen) ofdist))
35.             )
36.           )
37.         )
38.       )
39.     )
40.     (if start
41.         (setq method1 2)
42.         (cond
43.           ((= method1 1)
44.            (if (equal (angle p1 pm) (angle pm p2) fuzzy)
45.              (command "line" p1 p2 "")
46.              (command "arc" p1 pm p2)
47.            )
48.            (setvar "peditaccept" 1)
49.            (command "pedit" "last" "")
50.            (command "offset" "erase" "yes" "layer" "current" ofdist (entlast) side "")
51.            (setq s1 (entlast))
52.            (setq obj1 (vlax-ename->vla-object s1))
53.           )
54.           ((= method1 2)
56.            (vla-setbulge obj1 0 bulge)
57.            (setq s1 (vlax-vla-object->ename obj1))
58.           )
59.         )
60.         (setq method2 2)
61.         (cond ((= (vla-get-objectname obj) "AcDb2dPolyline") (setq method2 1)))
62.         (cond
63.           ((= method2 1) (setq w1 (nth param w1li)) (setq w2 (nth param w2li)))
64.           ((= method2 2) (vla-getwidth obj param 'w1 'w2))
65.         )
66.         (setq method3 2)
67.         (cond
68.           ((= method3 1) (command "pedit" s1 "e" "w" w1 w2 "x" ""))
69.           ((= method3 2) (vla-setwidth obj1 0 w1 w2))
70.         )
71.         (foreach prop '(elevation layer linetype linetypegeneration linetypescale lineweight normal truecolor) ;|  #matchprop  |;
72.           (cond ((vlax-property-available-p obj prop) (vlax-put obj1 prop (vlax-get obj prop))))
73.         )
74.         (setq pt1 (vlax-curve-getclosestpointto s1 pt))
75.         (grdraw pt pt1 9 1)
76.         (grdraw side pt1 8 1)
77.       )
78.     )
79.   )
80.   (defun sub3 ()
81.     (cond
82.       ((= (car a) 40) (setq w1li (append w1li (list (cdr a)))))
83.       ((= (car a) 41) (setq w2li (append w2li (list (cdr a)))))
84.       ((= (car a) 42) (setq buli (append buli (list (cdr a)))))
85.     )
86.   )
87.   (setq s1 nil)
88.   (setq es (entsel "\n Select Pline : "))
89.   (setq s (car es))
91.   (setq fuzzy 1e-4)
92.   (if (= 1 (getvar "cvport"))
93.   )
94.   (setvar "autosnap" 39)
95.   (setvar "orthomode" 0) ;|  #orthomode  |;
96.   (setvar "osmode" 0)
97.   (while s
98.     (redraw s 4)
99.     (setq en (entget s))
100.     (setq typ (strcase (cdr (assoc 0 en)) t))
101.     (setq w1li nil)
102.     (setq w2li nil)
103.     (setq buli nil)
104.     (cond
105.       ((= typ "lwpolyline") (foreach a en (sub3)))
106.       ((= typ "polyline")
107.        (setq sn (entnext s))
108.        (setq enn (entget sn))
109.        (setq typn (cdr (assoc 0 enn)))
110.        (while (/= typn "seqend")
111.          (foreach a enn (sub3))
112.          (setq sn (entnext sn))
113.          (setq enn (entget sn))
114.          (setq typn (strcase (cdr (assoc 0 enn)) t))
115.        )
116.       )
117.     )
118.     (setq obj (vlax-ename->vla-object s))
119.     (setq normal (vlax-get obj 'normal)) ;|  #normal vector  |;
120.     (setq poj (osnap poj "_nea"))
121.     (setq pt (trans poj 1 0))
122.     (setq param (fix (vlax-curve-getparamatpoint obj pt)))
123.     (setq p1 (trans (vlax-curve-getpointatparam obj param) 0 normal))
124.     (setq pm (trans (vlax-curve-getpointatparam obj (+ (float param) 0.5)) 0 normal))
125.     (setq p2 (trans (vlax-curve-getpointatparam obj (1+ param)) 0 normal))
126.     (setq g 1)
127.     (while (= g 1)
129.       (setq code (car gr))
131.       (cond
132.         ((= code 5) (sub1) (sub2)) ;| Bedune Click |;
133.         ((= code 3) ;| Click Beshe |;
134.          (sub1)
135.          (sub2)
136.          (setq s1 nil)
137.          (setvar "offsetdist" ofdist)
138.         )
139.         ((= code 2) (redraw) (sub1) (setq g 0)) ;| Type Beshe |;
140.         ((= code 25) (redraw) (sub1) (setq g 0)) ;| #mouse #right-click |;
141.       )
142.     )
143.     (setq s1 nil)
144.     (setq es (entsel "\n Select Pline : "))
145.     (setq s (car es))