Author Topic: Create Polyline Offset  (Read 16437 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: