### Author Topic: segment offset ?  (Read 19433 times)

0 Members and 1 Guest are viewing this topic.

#### dussla

• Bull Frog
• Posts: 297
##### segment offset ?
« 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 ?
« Last Edit: March 15, 2008, 09:31:40 PM by dussla »

#### gile

• Gator
• Posts: 2522
• Marseille, France
##### Re: segment offset ?
« Reply #1 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))
(* 2 (sin ang))
)
cen (polar p1
(+ (angle p1 p2) (- (/ pi 2) 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
)
(or *acdoc*
)
(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)
)
(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
)
)
(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)
)
« Last Edit: March 16, 2008, 03:10:50 AM by gile »
Speaking English as a French Frog

#### dussla

• Bull Frog
• Posts: 297
##### Re: segment offset ?
« Reply #2 on: March 15, 2008, 09:23:57 PM »
but there is error

« Last Edit: March 15, 2008, 11:28:07 PM by dussla »

#### gile

• Gator
• Posts: 2522
• Marseille, France
##### Re: segment offset ?
« Reply #3 on: March 16, 2008, 03:10:22 AM »
Oopss !
I forgot a parent.
It may work now.
Speaking English as a French Frog

#### dussla

• Bull Frog
• Posts: 297
##### Re: segment offset ?
« Reply #4 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 ~
« Last Edit: March 16, 2008, 04:50:45 AM by dussla »

#### gile

• Gator
• Posts: 2522
• Marseille, France
##### Re: segment offset ?
« Reply #5 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
)
(or *acdoc*
)
(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 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)
(distance (car arc_data) side)
)
(setq ofdist (- ofdist))
)
(if (< (distance (car arc_data) side)
)
(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)
(or *acdoc*
)
(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)
)
(trans pt 0 nor)
)
)
)
)
tmp
)
)
)
(setq copy
(vlax-invoke
space
(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))
(* 2 (sin ang))
)
cen (polar p1
(+ (angle p1 p2) (- (/ pi 2) 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
)
)
« Last Edit: March 26, 2008, 01:40:15 PM by gile »
Speaking English as a French Frog

#### Serge J. Gianolla

• Guest
##### Re: segment offset ?
« Reply #6 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  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".

#### Serge J. Gianolla

• Guest
##### Re: segment offset ?
« Reply #7 on: March 25, 2008, 01:43:30 AM »
Oops,
was thrown out of texting then it was end of lunchtime.

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!

#### gile

• Gator
• Posts: 2522
• Marseille, France
##### Re: segment offset ?
« Reply #8 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.
« Last Edit: March 25, 2008, 03:30:21 AM by gile »
Speaking English as a French Frog

#### ElpanovEvgeniy

• Water Moccasin
• Posts: 1569
• Moscow (Russia)
##### Re: segment offset ?
« Reply #9 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))

#### ElpanovEvgeniy

• Water Moccasin
• Posts: 1569
• Moscow (Russia)
##### Re: segment offset ?
« Reply #10 on: March 25, 2008, 07:03:35 AM »
The program not always works truly...

#### dussla

• Bull Frog
• Posts: 297
##### Re: segment offset ?
« Reply #11 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

#### gile

• Gator
• Posts: 2522
• Marseille, France
##### Re: segment offset ?
« Reply #12 on: March 25, 2008, 01:21:33 PM »
Thanks for the bug reporting Evgeniy.

I revised the code, I think it's corrected now.
Speaking English as a French Frog

#### gile

• Gator
• Posts: 2522
• Marseille, France
##### Re: segment offset ?
« Reply #13 on: March 25, 2008, 05:28:58 PM »
I revised the code: 'highlighting' selected segments (doesn't work very well on arcs).
Speaking English as a French Frog

#### gile

• Gator
• Posts: 2522
• Marseille, France
##### Re: segment offset ?
« Reply #14 on: March 26, 2008, 09:54:38 AM »
One more revision: a selected segment can be removed from the selection by clicking it again.
« Last Edit: March 26, 2008, 01:40:58 PM by gile »
Speaking English as a French Frog

#### kdub_nz

• Mesozoic keyThumper
• SuperMod
• Water Moccasin
• Posts: 2165
• class keyThumper<T>:ILazy<T>
##### Re: segment offset ?
« Reply #15 on: February 19, 2009, 01:17:51 AM »
gile,

Very NICE !! ..  Saved lots of time
Called Kerry in my other life
Retired; but they dragged me back in !

I live at UTC + 13.00

---
Sometimes the question is more important than the answer.

#### gile

• Gator
• Posts: 2522
• Marseille, France
##### Re: segment offset ?
« Reply #16 on: February 19, 2009, 01:21:00 AM »
You're welcome, Kerry.
Speaking English as a French Frog

#### CAB

• Global Moderator
• Seagull
• Posts: 10401
##### Re: segment offset ?
« Reply #17 on: February 19, 2009, 08:03:33 AM »
The coding is very nice and a useful routine.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970

#### GDF

• Water Moccasin
• Posts: 2085
##### Re: segment offset ?
« Reply #18 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
Why is there never enough time to do it right, but always enough time to do it over?

#### gile

• Gator
• Posts: 2522
• Marseille, France
##### Re: segment offset ?
« Reply #19 on: February 19, 2009, 03:04:24 PM »
Thanks to all, you're welcome.

I'm glad you find it usefull.
Speaking English as a French Frog

#### alanjt

• Needs a day job
• Posts: 5353
• Standby for witty remark...
##### Re: segment offset ?
« Reply #20 on: February 25, 2010, 09:33:21 AM »
Fantastic code, Gile; very useful.
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

#### rayakmal

• Newt
• Posts: 63
##### Re: segment offset ?
« Reply #21 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.

#### Lee Mac

• Seagull
• Posts: 12938
• London, England
##### Re: segment offset ?
« Reply #22 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.

#### rayakmal

• Newt
• Posts: 63
##### Re: segment offset ?
« Reply #23 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.

#### BIGAL

• Swamp Rat
• Posts: 1471
• 40 + years of using Autocad
##### Re: segment offset ?
« Reply #24 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.

#### rayakmal

• Newt
• Posts: 63
##### Re: segment offset ?
« Reply #25 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.

#### ahsattarian

• Newt
• Posts: 114
##### Re: segment offset ?
« Reply #26 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))