Author Topic: Create Polyline Offset  (Read 15458 times)

0 Members and 1 Guest are viewing this topic.

tdtboy04

  • Guest
Create Polyline Offset
« on: October 16, 2014, 01:30:31 AM »
Hi ,
Can you help me to write this lisp
I have 4 point ( or more  5, 6 , 7 ) . I want to create a polyline offset from these point , with fillet edge . ( Attach file below)
The offset distance and radius fillet can be change .
The offset side depend on the order of selection .
Ex :
Choose points or ( Offset distance / Radius ) :
Thanks a lot .
« Last Edit: October 16, 2014, 05:38:13 AM by tdtboy04 »

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Create Polyline Offset
« Reply #1 on: October 16, 2014, 05:54:25 AM »
If you do it manually it's only 4 commands ... and it can be done fairly fast.

PLINE        pick points
OFFSET     enter or confirm distance, pick line
ERASE   ( can be avoided by setting the Erase Source option for Offset to true ... but I prefer not to.)
FILLET      set or confirm distance , Select option P, Select Pline

You could base your program on this. BUT It could probably be done manually faster that the time it will take to find and load the lisp and remember the command to run .. and you still have to pick the points and nominate the offset distance and nominate the radius distance.

Command: PLINE
Specify start point:
Current line-width is 0.00000000
Specify next point or [Arc/Halfwidth/Length/Undo/Width]:
Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]:
Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]:
Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]:
Command: OFFSET
Current settings: Erase source=No  Layer=Source  OFFSETGAPTYPE=0
Specify offset distance or [Through/Erase/Layer] <300.00000000>:
Select object to offset or [Exit/Undo] <Exit>:
Specify point on side to offset or [Exit/Multiple/Undo] <Exit>:
Select object to offset or [Exit/Undo] <Exit>:
Command: ERASE
Select objects: 1 found
Select objects:
Command: FILLET
Current settings: Mode = TRIM, Radius = 100.00000000
Select first object or [Undo/Polyline/Radius/Trim/Multiple]: p
Select 2D polyline or [Radius]:
2 lines were filleted



kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

mostafa badran

  • Mosquito
  • Posts: 2
Re: Create Polyline Offset
« Reply #2 on: October 16, 2014, 01:42:43 PM »
Hi,
Do you want to offset and fillet the same object in the same time?

tdtboy04

  • Guest
Re: Create Polyline Offset
« Reply #3 on: October 16, 2014, 09:31:28 PM »
Yes !  8-) !

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Create Polyline Offset
« Reply #4 on: October 16, 2014, 09:36:32 PM »
Does the Polyline exist between the points, or do you want to follow the procedure I outlined ??

ie:
PLINE        pick points
OFFSET     enter or confirm distance, pick line
ERASE   ( can be avoided by setting the Erase Source option for Offset to true ... but I prefer not to.)
FILLET      set or confirm distance , Select option P, Select Pline

Quote
Can you help me to write this lisp
Do you want help, or do you want the code written for you ?
What code have you written for this task ?
« Last Edit: October 16, 2014, 09:41:17 PM by Kerry »
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Create Polyline Offset
« Reply #5 on: October 17, 2014, 12:40:34 AM »
Have a play ..

Library
Code - Auto/Visual Lisp: [Select]
  1. ;;;------------------------------------------------------------------
  2. ;;;------------------------------------------------------------------
  3. ;;;
  4. ;;; kwb 20021103
  5. ;;; KDUB:getdist (msg def bit kwd bpt
  6. ;;;
  7. ;;; Arguments:
  8. ;;; msg : The prompt string.
  9. ;;; def : Value to return if response is <enter>.
  10. ;;; bit  : initget bit
  11. ;;; kwd : Initget keywords string.
  12. ;;; bpt : Base point
  13. ;;;
  14. ;;; Note : Arguments may be set to nil
  15.  
  16. (defun kdub:getdist (msg def bit kwd bpt / returnvalue)
  17.   (or kwd (setq kwd ""))
  18.   (or bit (setq bit 1))
  19.   (setq msg (strcat "\n"
  20.                     (cond (msg)
  21.                           ("Specify Distance")
  22.                     )
  23.             )
  24.   )
  25.   (if def
  26.     (setq msg (strcat "\n" msg " <<" (rtos def) ">>: ")
  27.           bit (logand bit (~ 1))
  28.               ;; drop the 1 bit if def used
  29.     )
  30.     (setq msg (strcat "\n" msg ": "))
  31.   )
  32.   (initget bit kwd)
  33.   (setq returnvalue
  34.          (if bpt
  35.            (getdist msg bpt)
  36.            (getdist msg)
  37.          )
  38.   )
  39.   (if returnvalue
  40.     returnvalue
  41.     def
  42.   )
  43. )
  44. ;;;------------------------------------------------------------------
  45. ;;;------------------------------------------------------------------
  46. ;;;
  47. ;;; kwb 20021103
  48. ;;; KDUB:getpoint (msg def bit kwd bpt
  49.  
  50. ;;; Arguments:
  51. ;;; msg : The prompt string.
  52. ;;; def : Value to return if response is <enter>.
  53. ;;; bit   : initget bit
  54. ;;; kwd : Initget keywords string.
  55. ;;; bpt  : Base point
  56. ;;;
  57. ;;; requires KDUB:ptos
  58. ;;;
  59. (defun kdub:getpoint (promptmsg              ; The prompt string.
  60.                       default                ; return Value if <user enter> in UCS
  61.                       initbit                ; Initget bit
  62.                       keywordlist            ; Initget keywords List of strings
  63.                       basepoint              ; Base point < or nil >  in UCS
  64.                                              ;
  65.                       /               promptmessage   initstring
  66.                       keywordstring   returnvalue     parameterlist
  67.                      )
  68.   ;;------------------------------
  69.   (or initbit (setq initbit 0))
  70.   ;;------------------------------
  71.   (if keywordlist
  72.     (setq initstring    (substr
  73.                           (apply 'strcat
  74.                                  (mapcar '(lambda (item) (strcat " " item)) keywordlist)
  75.                           )
  76.                           2
  77.                         )
  78.           keywordstring (strcat " [" (vl-string-translate " " "/" initstring) "]")
  79.     )
  80.     (setq initstring ""
  81.           keywordstring ""
  82.     )
  83.   )
  84.   ;;------------------------------
  85.   (setq promptmessage
  86.          (strcat
  87.            "\n"
  88.            (cond (promptmsg)
  89.                  ("Specify Point")
  90.            )
  91.            keywordstring
  92.            (if default
  93.              (progn (setq initbit (logand initbit (~ 1)))
  94.                     (if (= (type default) 'str)
  95.                       (strcat " <<" default ">>")
  96.                       ;;
  97.                       ;; else, assume it is a point .. user beware
  98.                       (strcat " <<" (kdub:ptos default nil nil) ">>")
  99.                     )
  100.              )
  101.              ""
  102.            )
  103.            ": "
  104.          )
  105.   )
  106.   ;;------------------------------
  107.   (initget initbit initstring)
  108.         (setq returnvalue
  109.                (vl-catch-all-apply
  110.                  'getpoint
  111.                  (if basepoint               ; in ucs
  112.                    (list promptmessage basepoint)
  113.                    (list promptmessage)
  114.                  )
  115.                )
  116.         )
  117.       )
  118.     ;; ESC was pressed.
  119.     (setq returnvalue nil
  120.           default nil
  121.     )
  122.   )
  123.   (if returnvalue
  124.     returnvalue
  125.     default
  126.   )
  127. )
  128. ;;;------------------------------------------------------------------
  129. ;;;------------------------------------------------------------------
  130. ;;;
  131. ;;; kwb 20021103
  132. ;;; KDUB:ptos (pt xmode xprec
  133.  
  134. ;; Return a point formatted as a string
  135. ;; Arguments :
  136. ;; pt       : point list
  137. ;; xmode  : Units to use , can be nil
  138. ;; xprec   : display precision to use , can be nil
  139.  
  140. (defun kdub:ptos (pt xmode xprec)
  141.   (or xmode (setq xmode (getvar "LUNITS")))
  142.   (or xprec (setq xprec (getvar "LUPREC")))
  143.   (if pt
  144.     (strcat (rtos (car pt) xmode xprec)
  145.             ",  "
  146.             (rtos (cadr pt) xmode xprec)
  147.             ",  "
  148.             (rtos (caddr pt) xmode xprec)
  149.     )
  150.   )
  151. )
  152. ;;;------------------------------------------------------------------
  153. ;;;------------------------------------------------------------------
  154. (defun kdub:draw_lightweightpolyline
  155.        (VertexList la closeflag / modelspace ucsZNormal elev PolyObj)
  156.   (setq ucsZNormal (trans '(0 0 1) 1 0 t)
  157.         elev       (caddr (trans (car VertexList) 1 ucsZNormal))
  158.         modelspace (vla-get-modelspace
  159.                      (vla-get-activedocument (vlax-get-acad-object))
  160.                    )
  161.   )
  162.   (setq PolyObj (vlax-invoke
  163.                   modelspace
  164.                   'addLightWeightPolyline
  165.                   (apply 'append
  166.                          (mapcar '(lambda (pt)
  167.                                     (setq pt (trans pt 1 ucsZNormal))
  168.                                     (list (car pt) (cadr pt))
  169.                                   )
  170.                                  VertexList
  171.                          )
  172.                   )
  173.                 )
  174.   )
  175.   (vla-put-elevation PolyObj elev)
  176.   (if la
  177.     (vla-put-layer PolyObj la)
  178.   )
  179.   (vla-put-normal PolyObj (vlax-3d-point ucsZNormal))
  180.   (vla-put-closed PolyObj closeflag)
  181.   PolyObj
  182. )
  183.  
  184.  

Main Code
Code - Auto/Visual Lisp: [Select]
  1. (defun draw_pline (/ PointList dynamicPoint)
  2.   (setq PointList (list (setq dynamicPoint
  3.                                (kdub:getpoint "Start point.." nil 1 nil nil)
  4.                         )
  5.                   )
  6.   )
  7.   (while (setq dynamicPoint
  8.                 (kdub:getpoint
  9.                   "Specify next point.. (ESC) to cancel"
  10.                   nil                        1
  11.                   nil                        dynamicPoint
  12.                  )
  13.          )
  14.     (setq PointList (cons dynamicPoint PointList))
  15.   )
  16.   ;;(setq PointList (reverse PointList))
  17.   (kdub:draw_lightweightpolyline
  18.     (reverse PointList)
  19.     (getvar "CLAYER")
  20.     :vlax-false
  21.   )
  22. )
  23.  
  24.  
  25.  
  26. (defun c:doit (/ *error* plineObj offsetDist)
  27.   (defun *error* (msg /)
  28.     ;;----- Cancel any Active Commands -----------------------------
  29.     (while (< 0 (getvar "cmdactive")) (command))
  30.     ;;----- Display error message if applicable _-------------------
  31.     (cond
  32.       ((not msg))
  33.       ((member (strcase msg t)
  34.                '("console break" "function cancelled" "quit / exit abort")
  35.        )
  36.       )
  37.       ((princ (strcat "\nApplication Error: " (itoa (getvar "errno")) " :- " msg)
  38.        )
  39.        ;;----- Display backtrace ---------------------
  40.        (vl-bt)
  41.       )
  42.     )
  43.     (setvar "errno" 0)
  44.     (princ)
  45.   )
  46.   ;;-------------------------------------
  47.   ;;-------------------------------------
  48.   (setq plineObj     (draw_pline)
  49.         *offsetDist* (if *offsetDist*
  50.                        *offsetDist*
  51.                        200.0
  52.                      )
  53.         *filletDist* (if *filletDist*
  54.                        *filletDist*
  55.                        100.0
  56.                      )
  57.         offsetDist   (kdub:getdist "Offset Distance" *offsetDist* nil nil nil)
  58.         filletDist   (kdub:getdist "Fillet Distance" *filletDist* nil nil nil)
  59.   )
  60.   (if offsetDist
  61.     (setq *offsetDist* offsetDist)
  62.   )
  63.   (if filletDist
  64.     (setq *filletDist* filletDist)
  65.   )
  66.   (if (and offsetDist filletDist)
  67.     (progn (vla-offset plineObj  offsetDist)
  68.            (command-s "Fillet" "Polyline" "Radius" *filletDist* (entlast))
  69.            (vla-delete plineObj)
  70.     )
  71.   )
  72.   (*error* nil)
  73.   (princ)
  74. )
  75.  
  76. (prompt "\nFile loaded. Command to run:-  DOIT\n")
  77.  
  78.  

edit:
added (vla-delete plineObj)
« Last Edit: October 17, 2014, 01:06:05 AM by Kerry »
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

tdtboy04

  • Guest
Re: Create Polyline Offset
« Reply #6 on: October 17, 2014, 01:38:14 AM »
The offset command worked , but the fillet command didn't work .  :-( .
Thanks you so much , Kerry!  :-)

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Create Polyline Offset
« Reply #7 on: October 17, 2014, 01:57:49 AM »
The offset command worked , but the fillet command didn't work .  :-( .
Thanks you so much , Kerry!  :-)

Works for me on ac2015, 2014.

Was there an error message ?

Which Autocad build are you using ?
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Create Polyline Offset
« Reply #8 on: October 17, 2014, 03:53:36 AM »
Someone else care to try/test this routine please ??

The code is in the download with Reply #5

The First Post has a sample drawing.
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Create Polyline Offset
« Reply #9 on: October 17, 2014, 05:17:49 AM »
Maybe tdtboy04 is using a different language version and changing "Fillet" to "_Fillet" will solve the problem.

tdtboy04

  • Guest
Re: Create Polyline Offset
« Reply #10 on: October 17, 2014, 05:33:37 AM »
I'm using Autocad 2007 version
THIS IS MESSAGE
Command: DOIT

Start point..:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:
Invalid point.

Specify next point.. (ESC) to cancel: *Cancel*


Offset Distance <<200>>: 200


Fillet Distance <<100>>: 200

Application Error: 93 :- no function definition: COMMAND-S
Backtrace:
[0.59] (VL-BT)
[1.55] (*ERROR* "no function definition: COMMAND-S")
[2.50] (_call-err-hook #<SUBR @0b9f453c *ERROR*> "no function definition:
COMMAND-S")
[3.44] (sys-error "no function definition: COMMAND-S")
:ERROR-BREAK.39 nil
[4.36] (#<SUBR @07b0258c null-fun-hk> "Fillet" "Polyline" "Radius" 200.0
<Entity name: 7778e090>)
[5.28] (COMMAND-S "Fillet" "Polyline" "Radius" 200.0 <Entity name: 7778e090>)
[6.19] (C:DOIT)
[7.15] (#<SUBR @0b9f46f4 -rts_top->)
[8.12] (#<SUBR @07b02334 veval-str-body> "(C:DOIT)" T #<FILE internal>)
:CALLBACK-ENTRY.6 (:CALLBACK-ENTRY)
:ARQ-SUBR-CALLBACK.3 (nil 0)


Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Create Polyline Offset
« Reply #11 on: October 17, 2014, 05:36:10 AM »
Change
(command-s "Fillet" "Polyline" "Radius" *filletDist* (entlast))

to
(command  "_Fillet" "_Polyline" "_Radius" *filletDist* (entlast))

The command-s is required for AC2015 (and 'works' in 2014)


Just a note:
If you had posted the error message earlier we could have fixed this 4 hours ago. :-)
« Last Edit: October 17, 2014, 06:20:48 AM by Kerry »
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

tdtboy04

  • Guest
Re: Create Polyline Offset
« Reply #12 on: October 17, 2014, 06:34:45 AM »
i am very sorry ! My company doesn't allow staff online on working time .  :-(

This is new message
Command: doit

Start point..:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel: *Cancel*


Offset Distance <<200.0000>>:

Fillet Distance <<300.0000>>:  _Fillet
Current settings: Mode = TRIM, Radius = 300.0000
Select first object or [uNdo/Polyline/Radius/Trim/mUltiple]: _Polyline Select
2D polyline: _Radius

*Invalid selection*
Expects a point or Window/Last/Crossing/BOX/Fence/WPolygon/CPolygon
Select 2D polyline:

« Last Edit: October 17, 2014, 06:38:29 AM by tdtboy04 »

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Create Polyline Offset
« Reply #13 on: October 17, 2014, 06:42:46 AM »
Can you make the fillet manually and post the text from the command line back here.
added please type the responses ; don't just hit enter to accept the defaults.

Perhaps AC2007 has a different command sequence to AC2015. It's a while since I've used ac2007.

« Last Edit: October 17, 2014, 06:47:04 AM by Kerry »
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

tdtboy04

  • Guest
Re: Create Polyline Offset
« Reply #14 on: October 17, 2014, 06:45:36 AM »
 :-)
Command: f
FILLET
Current settings: Mode = TRIM, Radius = 300.0000
Select first object or [Undo/Polyline/Radius/Trim/Multiple]:
Select second object or shift-select to apply corner:
Command: f
FILLET
Current settings: Mode = TRIM, Radius = 300.0000
Select first object or [Undo/Polyline/Radius/Trim/Multiple]:
Select second object or shift-select to apply corner:
Command:  FILLET
Current settings: Mode = TRIM, Radius = 300.0000
Select first object or [Undo/Polyline/Radius/Trim/Multiple]:
Select second object or shift-select to apply corner:

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Create Polyline Offset
« Reply #15 on: October 17, 2014, 06:48:19 AM »
Please use the Polyline option.
and please type the responses ; don't just hit enter to accept the defaults.

Something like this :

Command: FILLET
Current settings: Mode = TRIM, Radius = 100.0000
Select first object or [Undo/Polyline/Radius/Trim/Multiple]: r
Specify fillet radius <100.0000>: 222
Select first object or [Undo/Polyline/Radius/Trim/Multiple]: poly
Select 2D polyline or [Radius]:
2 lines were filleted


OR this

Command: FILLET
Current settings: Mode = TRIM, Radius = 222.0000
Select first object or [Undo/Polyline/Radius/Trim/Multiple]: Poly
Select 2D polyline or [Radius]: Rad
Specify fillet radius <222.0000>: 333
Select 2D polyline or [Radius]:
2 lines were filleted
« Last Edit: October 17, 2014, 06:53:46 AM by Kerry »
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

tdtboy04

  • Guest
Re: Create Polyline Offset
« Reply #16 on: October 17, 2014, 06:54:20 AM »
did you mean ?
Command: pl
PLINE
Specify start point:
Current line-width is 0.0000
Specify next point or [Arc/Halfwidth/Length/Undo/Width]:
Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]:
Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]:
Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]:
Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]: *Cancel*

Command: f
FILLET
Current settings: Mode = TRIM, Radius = 300.0000
Select first object or [Undo/Polyline/Radius/Trim/Multiple]: r
Specify fillet radius <300.0000>: 500

Select first object or [Undo/Polyline/Radius/Trim/Multiple]: p
Select 2D polyline:
3 lines were filleted

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Create Polyline Offset
« Reply #17 on: October 17, 2014, 07:00:51 AM »
Good,
Now try the fillet using the Polly Option before the RAD option ... as per the second example in Reply #15 ( 2 above )


ADDED:
Are you using an English version of AutoCAD ??
« Last Edit: October 17, 2014, 07:03:55 AM by Kerry »
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

tdtboy04

  • Guest
Re: Create Polyline Offset
« Reply #18 on: October 17, 2014, 07:05:06 AM »
Command: f
FILLET
Current settings: Mode = TRIM, Radius = 500.0000
Select first object or [Undo/Polyline/Radius/Trim/Multiple]: poly
Select 2D polyline: rad


*Invalid selection*
Expects a point or Window/Last/Crossing/BOX/Fence/WPolygon/CPolygon
Select 2D polyline: 800

3 lines were filleted

I am using English version .
« Last Edit: October 17, 2014, 07:08:34 AM by tdtboy04 »

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Create Polyline Offset
« Reply #19 on: October 17, 2014, 07:09:23 AM »

GREAT !!

The AC2007 command sequence is different, we need to ask for the radius first, then the Poly Option, SO ;

Try

Code - Auto/Visual Lisp: [Select]
  1. (command "_Fillet" "_Radius" *filletDist*  "_Polyline" (entlast))

In the Lisp file.
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

tdtboy04

  • Guest
Re: Create Polyline Offset
« Reply #20 on: October 17, 2014, 07:16:30 AM »
I Change
(command-s "Fillet" "Polyline" "Radius" *filletDist* (entlast))

to
(command "_Fillet" "_Radius" *filletDist*  "_Polyline" (entlast))

and the message :
Start point..:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:

Invalid point.

Specify next point.. (ESC) to cancel: *Cancel*


Offset Distance <<200.0000>>: 500


Fillet Distance <<300.0000>>: 500
_Fillet
Current settings: Mode = TRIM, Radius = 500.0000
Select first object or [uNdo/Polyline/Radius/Trim/mUltiple]: _Polyline Select
2D polyline: _Radius

*Invalid selection*
Expects a point or Window/Last/Crossing/BOX/Fence/WPolygon/CPolygon
Select 2D polyline:

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Create Polyline Offset
« Reply #21 on: October 17, 2014, 07:23:54 AM »
Can you please post the c:DOIT function.
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

tdtboy04

  • Guest
Re: Create Polyline Offset
« Reply #22 on: October 17, 2014, 07:28:22 AM »
Code: [Select]
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;;;
;;; kwb 20021103
;;; KDUB:getdist (msg def bit kwd bpt
;;;
;;; Arguments:
;;; msg : The prompt string.
;;; def : Value to return if response is <enter>.
;;; bit  : initget bit
;;; kwd : Initget keywords string.
;;; bpt : Base point
;;;
;;; Note : Arguments may be set to nil

(defun kdub:getdist (msg def bit kwd bpt / returnvalue)
  (or kwd (setq kwd ""))
  (or bit (setq bit 1))
  (setq msg (strcat "\n"
                    (cond (msg)
                          ("Specify Distance")
                    )
            )
  )
  (if def
    (setq msg (strcat "\n" msg " <<" (rtos def) ">>: ")
          bit (logand bit (~ 1))
              ;; drop the 1 bit if def used
    )
    (setq msg (strcat "\n" msg ": "))
  )
  (initget bit kwd)
  (setq returnvalue
         (if bpt
           (getdist msg bpt)
           (getdist msg)
         )
  )
  (if returnvalue
    returnvalue
    def
  )
)
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;;;
;;; kwb 20021103
;;; KDUB:getpoint (msg def bit kwd bpt

;;; Arguments:
;;; msg : The prompt string.
;;; def : Value to return if response is <enter>.
;;; bit   : initget bit
;;; kwd : Initget keywords string.
;;; bpt  : Base point
;;;
;;; requires KDUB:ptos
;;;
(defun kdub:getpoint (promptmsg              ; The prompt string.
                      default                ; return Value if <user enter> in UCS
                      initbit                ; Initget bit
                      keywordlist            ; Initget keywords List of strings
                      basepoint              ; Base point < or nil >  in UCS
                                             ;
                      /               promptmessage   initstring
                      keywordstring   returnvalue     parameterlist
                     )
  ;;------------------------------
  (or initbit (setq initbit 0))
  ;;------------------------------
  (if keywordlist
    (setq initstring    (substr
                          (apply 'strcat
                                 (mapcar '(lambda (item) (strcat " " item)) keywordlist)
                          )
                          2
                        )
          keywordstring (strcat " [" (vl-string-translate " " "/" initstring) "]")
    )
    (setq initstring ""
          keywordstring ""
    )
  )
  ;;------------------------------
  (setq promptmessage
         (strcat
           "\n"
           (cond (promptmsg)
                 ("Specify Point")
           )
           keywordstring
           (if default
             (progn (setq initbit (logand initbit (~ 1)))
                    (if (= (type default) 'str)
                      (strcat " <<" default ">>")
                      ;;
                      ;; else, assume it is a point .. user beware
                      (strcat " <<" (kdub:ptos default nil nil) ">>")
                    )
             )
             ""
           )
           ": "
         )
  )
  ;;------------------------------
  (initget initbit initstring)
  (if (vl-catch-all-error-p
        (setq returnvalue
               (vl-catch-all-apply
                 'getpoint
                 (if basepoint               ; in ucs
                   (list promptmessage basepoint)
                   (list promptmessage)
                 )
               )
        )
      )
    ;; ESC was pressed.
    (setq returnvalue nil
          default nil
    )
  )
  (if returnvalue
    returnvalue
    default
  )
)
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;;;
;;; kwb 20021103
;;; KDUB:ptos (pt xmode xprec

;; Return a point formatted as a string
;; Arguments :
;; pt       : point list
;; xmode  : Units to use , can be nil
;; xprec   : display precision to use , can be nil

(defun kdub:ptos (pt xmode xprec)
  (or xmode (setq xmode (getvar "LUNITS")))
  (or xprec (setq xprec (getvar "LUPREC")))
  (if pt
    (strcat (rtos (car pt) xmode xprec)
            ",  "
            (rtos (cadr pt) xmode xprec)
            ",  "
            (rtos (caddr pt) xmode xprec)
    )
  )
)
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
(defun kdub:draw_lightweightpolyline
       (VertexList la closeflag / modelspace ucsZNormal elev PolyObj)
  (setq ucsZNormal (trans '(0 0 1) 1 0 t)
        elev       (caddr (trans (car VertexList) 1 ucsZNormal))
        modelspace (vla-get-modelspace
                     (vla-get-activedocument (vlax-get-acad-object))
                   )
  )
  (setq PolyObj (vlax-invoke
                  modelspace
                  'addLightWeightPolyline
                  (apply 'append
                         (mapcar '(lambda (pt)
                                    (setq pt (trans pt 1 ucsZNormal))
                                    (list (car pt) (cadr pt))
                                  )
                                 VertexList
                         )
                  )
                )
  )
  (vla-put-elevation PolyObj elev)
  (if la
    (vla-put-layer PolyObj la)
  )
  (vla-put-normal PolyObj (vlax-3d-point ucsZNormal))
  (vla-put-closed PolyObj closeflag)
  PolyObj
)

;;;------------------------------------------------------------------
;;;------------------------------------------------------------------


(defun draw_pline (/ PointList dynamicPoint)
  (setq PointList (list (setq dynamicPoint
                               (kdub:getpoint "Start point.." nil 1 nil nil)
                        )
                  )
  )
  (while (setq dynamicPoint
                (kdub:getpoint
                  "Specify next point.. (ESC) to cancel"
                  nil                        1
                  nil                        dynamicPoint
                 )
         )
    (setq PointList (cons dynamicPoint PointList))
  )
  (kdub:draw_lightweightpolyline
    (reverse PointList)
    (getvar "CLAYER")
    :vlax-false
  )
)



(defun c:doit (/ *error* plineObj offsetDist)
  (defun *error* (msg /)
    ;;----- Cancel any Active Commands -----------------------------
    (while (< 0 (getvar "cmdactive")) (command))
    ;;----- Display error message if applicable _-------------------
    (cond
      ((not msg))
      ((member (strcase msg t)
               '("console break" "function cancelled" "quit / exit abort")
       )
      )
      ((princ (strcat "\nApplication Error: " (itoa (getvar "errno")) " :- " msg)
       )
       ;;----- Display backtrace ---------------------
       (vl-bt)
      )
    )
    (setvar "errno" 0)
    (princ)
  )
  ;;-------------------------------------
  ;;-------------------------------------
  (setq plineObj     (draw_pline)
        *offsetDist* (if *offsetDist*
                       *offsetDist*
                       200.0
                     )
        *filletDist* (if *filletDist*
                       *filletDist*
                       100.0
                     )
        offsetDist   (kdub:getdist "Offset Distance" *offsetDist* nil nil nil)
        filletDist   (kdub:getdist "Fillet Distance" *filletDist* nil nil nil)
  )
  (if offsetDist
    (setq *offsetDist* offsetDist)
  )
  (if filletDist
    (setq *filletDist* filletDist)
  )
  (if (and offsetDist filletDist)
    (progn (vla-offset plineObj offsetDist)
           (command "_Fillet" "_Radius" *filletDist*  "_Polyline" (entlast))
           (vla-delete plineObj)
    )
  )
  (*error* nil)
  (princ)
)

(prompt "\nFile loaded. Command to run:-  DOIT\n")
(princ)


 ;|«Visual LISP© Format Options»
(80 2 45 2 nil "end of " 80 9 1 0 0 nil nil nil T)
;*** DO NOT add text below the comment! ***|;

and the message :
Command: doit

Start point..:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:

Invalid point.

Specify next point.. (ESC) to cancel: *Cancel*


Offset Distance <<500.0000>>:


Fillet Distance <<500.0000>>:
_Fillet
Current settings: Mode = TRIM, Radius = 500.0000
Select first object or [uNdo/Polyline/Radius/Trim/mUltiple]: _Polyline Select
2D polyline: _Radius

*Invalid selection*
Expects a point or Window/Last/Crossing/BOX/Fence/WPolygon/CPolygon
Select 2D polyline:

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Create Polyline Offset
« Reply #23 on: October 17, 2014, 07:34:37 AM »


Thanks,
Can you please draw 2 polylines manually,
and then run these 2 commands, one on each polyline.
Code - Auto/Visual Lisp: [Select]
  1. (defun c:Test1 ()
  2.         (setq pl (car (entsel)))
  3.         (command "_Fillet" "Polyline" "Radius" 123 pl)
  4. )
  5.  
  6. (defun c:Test2 ()
  7.         (setq pl (car (entsel)))
  8.         (command "_Fillet" "Radius" 123 "Polyline"  pl)
  9. )

For me in ac2015 test1 works , test2 throws an error.
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

tdtboy04

  • Guest
Re: Create Polyline Offset
« Reply #24 on: October 17, 2014, 07:45:12 AM »
Command: test1

Select object: _Fillet
Current settings: Mode = TRIM, Radius = 20.0000
Select first object or [uNdo/Polyline/Radius/Trim/mUltiple]: Polyline Select 2D
polyline: Radius

*Invalid selection*
Expects a point or Window/Last/Crossing/BOX/Fence/WPolygon/CPolygon
; error: Function cancelled
Select 2D polyline:
2 lines were filleted

Command:
Command: test2

Select object: _Fillet
Current settings: Mode = TRIM, Radius = 20.0000
Select first object or [uNdo/Polyline/Radius/Trim/mUltiple]: Radius Specify
fillet radius <20.0000>: 123
Command: Polyline Unknown command "POLYLINE".  Press F1 for help.

Command: <Entity name: FFEBB0A8>
 TEST2 Unknown command "TEST2".  Press F1 for help.

Command: nil

Test 1 work , test 2 error


Manual Fillet

Command: f
FILLET
Current settings: Mode = TRIM, Radius = 20.0000
Select first object or [Undo/Polyline/Radius/Trim/Multiple]: r
Specify fillet radius <20.0000>: 20

Select first object or [Undo/Polyline/Radius/Trim/Multiple]: poly
Select 2D polyline:
2 lines were filleted

ChrisCarlson

  • Guest
Re: Create Polyline Offset
« Reply #25 on: October 17, 2014, 07:57:45 AM »
On 2015 both test functions should work but Test2 seems to fail. Both of which are valid processes if done manually, so what's going on?

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Create Polyline Offset
« Reply #26 on: October 17, 2014, 07:59:58 AM »
This is really weird.
Both tests work for me if I use Command-S ( for AC2015 )
And both work manually from the command line.

Can you please test TEST1 and TEST2 again.

Then try the command sequence in the lisp that seems to work for the Test.

I'll wait till you try it.

ADDED:
Thanks Chris.
What is your result in 2015 if you use Command-S ??

And Added:
If I use Command in 2015
Quote
For me in ac2015 test1 works , test2 throws an error.

Added .. I was wrong .. Test 2 is not working using either command or command-s   :| :|

Thime for bed for me I think.
« Last Edit: October 17, 2014, 08:07:55 AM by Kerry »
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

tdtboy04

  • Guest
Re: Create Polyline Offset
« Reply #27 on: October 17, 2014, 08:08:01 AM »
Command: f
FILLET
Current settings: Mode = TRIM, Radius = 0.0000
Select first object or [Undo/Polyline/Radius/Trim/Multiple]: r
Specify fillet radius <0.0000>: 5

Select first object or [Undo/Polyline/Radius/Trim/Multiple]:
Command: test1

Select object: _Fillet
Current settings: Mode = TRIM, Radius = 5.0000
Select first object or [uNdo/Polyline/Radius/Trim/mUltiple]: Polyline Select 2D
polyline: Radius

*Invalid selection*
Expects a point or Window/Last/Crossing/BOX/Fence/WPolygon/CPolygon
; error: Function cancelled
Select 2D polyline:
2 lines were filleted


Command: test2

Select object: _Fillet
Current settings: Mode = TRIM, Radius = 5.0000
Select first object or [uNdo/Polyline/Radius/Trim/mUltiple]: Radius Specify
fillet radius <5.0000>: 123
Command: Polyline Unknown command "POLYLINE".  Press F1 for help.

Command: <Entity name: FFECB088>
 TEST2 Unknown command "TEST2".  Press F1 for help.

Command: nil

Command:  TEST2
Select object:  _Fillet
Current settings: Mode = TRIM, Radius = 123.0000
Select first object or [uNdo/Polyline/Radius/Trim/mUltiple]: Radius Specify
fillet radius <123.0000>: 123
Command: Polyline Unknown command "POLYLINE".  Press F1 for help.

Command:
Command: nil

Command: doit

Start point..:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:

Invalid point.

Specify next point.. (ESC) to cancel: *Cancel*


Offset Distance <<200.0000>>: 5


Fillet Distance <<100.0000>>: 5
_Fillet
Current settings: Mode = TRIM, Radius = 123.0000
Select first object or [uNdo/Polyline/Radius/Trim/mUltiple]: _Polyline Select
2D polyline: _Radius

*Invalid selection*
Expects a point or Window/Last/Crossing/BOX/Fence/WPolygon/CPolygon
Select 2D polyline:

Test1 work , but test2 error

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Create Polyline Offset
« Reply #28 on: October 17, 2014, 08:12:43 AM »
If test 1 works then

Code - Auto/Visual Lisp: [Select]
  1.   (if (and offsetDist filletDist)
  2.     (progn (vla-offset plineObj offsetDist)
  3.            (command "_Fillet" "_Polyline" "_Radius" *filletDist*  (entlast))
  4.            (vla-delete plineObj)
  5.     )
  6.   )

SHOULD work in the c:DOIT code in Ac2007. ( I believe :-D )
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

tdtboy04

  • Guest
Re: Create Polyline Offset
« Reply #29 on: October 17, 2014, 08:20:35 AM »
Code: [Select]
(defun c:doit (/ *error* plineObj offsetDist)
  (defun *error* (msg /)
    ;;----- Cancel any Active Commands -----------------------------
    (while (< 0 (getvar "cmdactive")) (command))
    ;;----- Display error message if applicable _-------------------
    (cond
      ((not msg))
      ((member (strcase msg t)
               '("console break" "function cancelled" "quit / exit abort")
       )
      )
      ((princ (strcat "\nApplication Error: " (itoa (getvar "errno")) " :- " msg)
       )
       ;;----- Display backtrace ---------------------
       (vl-bt)
      )
    )
    (setvar "errno" 0)
    (princ)
  )
  ;;-------------------------------------
  ;;-------------------------------------
  (setq plineObj     (draw_pline)
        *offsetDist* (if *offsetDist*
                       *offsetDist*
                       200.0
                     )
        *filletDist* (if *filletDist*
                       *filletDist*
                       100.0
                     )
        offsetDist   (kdub:getdist "Offset Distance" *offsetDist* nil nil nil)
        filletDist   (kdub:getdist "Fillet Distance" *filletDist* nil nil nil)
  )
  (if offsetDist
    (setq *offsetDist* offsetDist)
  )
  (if filletDist
    (setq *filletDist* filletDist)
  )
      (if (and offsetDist filletDist)
       (progn (vla-offset plineObj offsetDist)
              (command "_Fillet" "_Polyline" "_Radius" *filletDist*  (entlast))
              (vla-delete plineObj)
       )
     )
  (*error* nil)
  (princ)
)

(prompt "\nFile loaded. Command to run:-  DOIT\n")
(princ)


 ;|«Visual LISP© Format Options»
(80 2 45 2 nil "end of " 80 9 1 0 0 nil nil nil T)
;*** DO NOT add text below the comment! ***|;
I change the code , but it doesn't work !
I think I should use 2014 version .
Thanks you so much , Kerry ! Nice to know you !

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Create Polyline Offset
« Reply #30 on: October 17, 2014, 08:25:13 AM »
tdtboy04,
I'm trying to make sense of your results and I can't.

Did you try Test1 ?

You may need to try Test1 and Test 2 again.

Then try the commands again manually,
once using Polyline first option
and once using Polyline second option


kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

tdtboy04

  • Guest
Re: Create Polyline Offset
« Reply #31 on: October 17, 2014, 08:43:40 AM »
Code: [Select]
Command: test1

Select object: _Fillet
Current settings: Mode = TRIM, Radius = 5.0000
Select first object or [uNdo/Polyline/Radius/Trim/mUltiple]: Polyline Select 2D
polyline: Radius

*Invalid selection*
Expects a point or Window/Last/Crossing/BOX/Fence/WPolygon/CPolygon
; error: Function cancelled
Select 2D polyline:
2 lines were filleted


Command: test2

Select object: _Fillet
Current settings: Mode = TRIM, Radius = 5.0000
Select first object or [uNdo/Polyline/Radius/Trim/mUltiple]: Radius Specify
fillet radius <5.0000>: 123
Command: Polyline Unknown command "POLYLINE".  Press F1 for help.

Command: <Entity name: FFEE30C0>
 TEST2 Unknown command "TEST2".  Press F1 for help.

Command: nil

Command:  TEST2
Select object: *Cancel*
; error: Function cancelled


Command: f
FILLET
Current settings: Mode = TRIM, Radius = 123.0000
Select first object or [Undo/Polyline/Radius/Trim/Multiple]: poly
Select 2D polyline: r


*Invalid selection*
Expects a point or Window/Last/Crossing/BOX/Fence/WPolygon/CPolygon
Select 2D polyline:
1 line was filleted
1 was too short

Command: f
FILLET
Current settings: Mode = TRIM, Radius = 123.0000
Select first object or [Undo/Polyline/Radius/Trim/Multiple]: r
Specify fillet radius <123.0000>: 5

Select first object or [Undo/Polyline/Radius/Trim/Multiple]: poly
Select 2D polyline:
2 lines were filleted
The fillet command work when i specify fillet radius then poly

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Create Polyline Offset
« Reply #32 on: October 17, 2014, 08:58:56 AM »
Just for fun,
Does this work in 2007 ??

Code - Auto/Visual Lisp: [Select]
  1. (defun c:Test3 ()
  2.   (setq pl (car (entsel))
  3.         *filletDist* 125
  4.   )
  5.   (setvar "FILLETRAD" *filletDist*)
  6.   (command "_Fillet" "Polyline" pl)
  7. )
  8.  
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

tdtboy04

  • Guest
Re: Create Polyline Offset
« Reply #33 on: October 17, 2014, 09:41:06 AM »
Yes , it works
Command: test3

Select object: _Fillet
Current settings: Mode = TRIM, Radius = 125.0000
Select first object or [uNdo/Polyline/Radius/Trim/mUltiple]: Polyline Select 2D
polyline:
3 lines were filleted


Command: nil
« Last Edit: October 17, 2014, 09:47:03 AM by tdtboy04 »

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Create Polyline Offset
« Reply #34 on: October 17, 2014, 06:15:52 PM »
In that case, make these changes to c:doit and all should be well
Code - Auto/Visual Lisp: [Select]
  1. (if (and offsetDist filletDist)
  2.     (progn
  3.           (vla-offset plineObj offsetDist)
  4.           (setvar "FILLETRAD" *filletDist*)
  5.           (command "_Fillet" "Polyline" (entlast))
  6.           (vla-delete plineObj)
  7.     )
  8.   )
« Last Edit: October 18, 2014, 12:11:15 AM by Kerry »
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

tdtboy04

  • Guest
Re: Create Polyline Offset
« Reply #35 on: October 17, 2014, 11:27:46 PM »
the message
Command: doit

Start point..:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel:
Specify next point.. (ESC) to cancel: *Cancel*


Offset Distance <<20.0000>>: 200


Fillet Distance <<20.0000>>: 200
_Fillet
Current settings: Mode = TRIM, Radius = 200.0000
Select first object or [uNdo/Polyline/Radius/Trim/mUltiple]: Polyline Select 2D
polyline:
Command:

the code : (vla-delete plineObj) works , but the fillet command doesn't work ( like we did not select the polyline ? ).
« Last Edit: October 17, 2014, 11:40:58 PM by tdtboy04 »

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Create Polyline Offset
« Reply #36 on: October 18, 2014, 12:14:17 AM »
The snippet was filleting the object from the test3 code.  :cry:  my bad!

change the code
(command "_Fillet" "Polyline" pl)
 to :
Code - Auto/Visual Lisp: [Select]
  1. (command "_Fillet" "Polyline" (entlast))
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

tdtboy04

  • Guest
Re: Create Polyline Offset
« Reply #37 on: October 18, 2014, 12:58:41 AM »
Finally , it works perfectly  :-)
Thank you so much , Kerry ! :angel:
This lisp so helpful for me .



edit-kdub : attachment removed.
« Last Edit: October 18, 2014, 01:38:38 AM by Kerry »

ScottMC

  • Newt
  • Posts: 191
Re: Create Polyline Offset
« Reply #38 on: December 11, 2019, 01:17:37 PM »
Using this with my A2K, This always avoided selection so I added at Line 111 and 307:
...
     111->>  (setq e (car (entsel "\nSelect a Polyline or Line: " )))
                   (command "convertpoly" "H" e "")
...
            307 -->>    (retrieve)
            (command "convertpoly" "L" f "")

ahsattarian

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