Author Topic: Draw a polyline with a certain offset  (Read 5144 times)

0 Members and 1 Guest are viewing this topic.

Coder

  • Swamp Rat
  • Posts: 827
Re: Draw a polyline with a certain offset
« Reply #15 on: August 26, 2019, 09:31:02 AM »
Can anyone translate that into codes?

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Draw a polyline with a certain offset
« Reply #16 on: August 26, 2019, 05:19:57 PM »
Something like this can work to pick the base points on the existing polyline:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:Test ( / param pt ptLst segmLst sel)
  2.   (while (setq sel (entsel "\nSelect poly near endpoints or 2x near midpoint to select segments for intersection: "))
  3.     (setq pt (osnap (cadr sel) "nea"))
  4.     (cond
  5.       ((zerop (rem param 1.0))
  6.         (setq ptLst (cons (vlax-curve-getpointatparam (car sel) param) ptLst))
  7.       )
  8.       ((> 0.3 (rem param 1.0))
  9.         (setq ptLst (cons (vlax-curve-getpointatparam (car sel) (fix param)) ptLst))
  10.       )
  11.       ((< 0.7 (rem param 1.0))
  12.         (setq ptLst (cons (vlax-curve-getpointatparam (car sel) (fix (1+ param))) ptLst))
  13.       )
  14.       (T
  15.         (setq segmLst
  16.           (cons
  17.             (list
  18.               (vlax-curve-getpointatparam (car sel) (fix param))
  19.               (vlax-curve-getpointatparam (car sel) (fix (1+ param)))
  20.             )
  21.             segmLst
  22.           )
  23.         )
  24.         (if (= 2 (length segmLst))
  25.           (progn
  26.             (setq ptLst
  27.               (cons
  28.                 (inters
  29.                   (caar segmLst)
  30.                   (cadar segmLst)
  31.                   (caadr segmLst)
  32.                   (cadadr segmLst)
  33.                   nil ; Nil=lines are infinite.
  34.                 )
  35.                 ptLst
  36.               )
  37.             )
  38.             (setq segmLst nil)
  39.           )
  40.         )
  41.       )
  42.     )
  43.   )
  44.   (setvar 'pdmode 35)
  45.   (foreach pt ptLst
  46.     (entmake
  47.       (list
  48.         '(0 . "POINT")
  49.         (cons 10 pt)
  50.       )
  51.     )
  52.   )
  53.   (princ)
  54. )

Coder

  • Swamp Rat
  • Posts: 827
Re: Draw a polyline with a certain offset
« Reply #17 on: August 26, 2019, 05:48:35 PM »
Thank you roy_043 for your time and efforts.

I could not make it to work and I did not know how to work with 2x with the message to the user!
Sorry for that, because of my lack knowledge with Lisp.

BIGAL

  • Swamp Rat
  • Posts: 1398
  • 40 + years of using Autocad
Re: Draw a polyline with a certain offset
« Reply #18 on: August 27, 2019, 02:00:33 AM »
We are all on the same page one other routine I did drew a new line then filleted back onto the pre offset pline hence joining the new pline. So doing the "extend" reverses offset side then to p6 p7 a back fillet. I will try to find was a long time ago.

While we figure it out draw 1-5 then start again 9 8 7 6 fillet the two answers all done.

Have a look at screen shot the code I am trying to find filleted as it created new lines. You would need CAB's getpoint or string to flip direction L-R Yes it would use points not segments. That could be version 2.
This is like 1st ten lines. 1st code was for testing. I know lee-mac has a left or right for picked point.

Code - Auto/Visual Lisp: [Select]
  1.  (initget 6 "Swap")
  2. (while  (setq pt2 (getpoint "\nPick  start point or [Swap sides]:<"   ))
  3.        (cond
  4.           ((= (type pt2) 'LIST) (princ pt2))
  5.           ((= pt2 "Swap") (Alert "swap"))
  6.           ((= pt2 nil)(quit))
  7.      )
  8. (initget 6 "Swap")
  9. )
  10.  

Code - Auto/Visual Lisp: [Select]
  1.  
  2. (setq offd (getstring "R or L"))
  3. (setq pt1 (getpoint "pick 1st point"))
  4. (initget 6 "Swap")
  5. (while  (setq pt2 (getpoint "\nPick  start point or [Swap sides]:<"   ))
  6.        (cond
  7.           ((= (type pt2) 'LIST) (drawlines))
  8.           ((= pt2 "Swap") (swapr-l)) ; also calls drawlines
  9.           ((= pt2 nil)(quit))
  10.      )
  11. (initget 6 "Swap")
  12. )
  13.  

« Last Edit: August 27, 2019, 03:09:36 AM by BIGAL »
A man who never made a mistake never made anything

BIGAL

  • Swamp Rat
  • Posts: 1398
  • 40 + years of using Autocad
Re: Draw a polyline with a certain offset
« Reply #19 on: August 27, 2019, 06:21:45 AM »
Had a play thanks CAB for the getpoint / string

Roy_43 please feel free to add pline segments its probably though fast enough without trying to reduce pick points. It does not check for non square ends.

Code: [Select]
; draw offsets from points for random shape object making pline
; By Alan H AUG 2019


(defun ah:ploffs (/ offdir offd x pt1 pt2 pt3 oldsnap ssp)

  (defun drawline (/ ang pt3 obj)
    (setq ang (angle pt1 pt2))
    (if (= offdir "L")
      (setq pt3 (polar pt2 (+ ang (/ pi 2.0)) 10))
      (setq pt3 (polar pt2 (- ang (/ pi 2.0)) 10))
    )
    (setvar 'osmode 0)
    (command "line" pt1 pt2 "")
    (setq obj (entlast))
    (command "offset" offd obj pt3 "")
    (setq ssp (ssadd (entlast) ssp))
    (command "erase" obj "")
    (setq pt1 pt2)
  )

  (defun swapr-l (/)
    (if (= (strcase offdir) "L")
      (setq offdir "R")
      (setq offdir "L")
    )
    (setvar 'osmode oldsnap)
    (setq pt1 (getpoint "\nPick  next point"))
    (setq pt2 (getpoint "\nPick  next point"))
    (drawline)
  )


; starts here
; add side pick
  (setq oldsnap (getvar 'osmode))
  (setq ssp nil)

  (initget 6 "R L")
  (setq offdir (strcase (getstring "Right or  Left")))
  (setq offd (getreal "Enter offset distance"))


  (setq pt1 (getpoint "pick 1st point"))
  (setq ssp (ssadd))

  (initget 6 "1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z")
  (while (setq pt2 (getpoint "\nPick  next point or [S Swap sides]:<"))
    (cond
      ((= (type pt2) 'LIST) (drawline))
      ((= (type pt2) 'str) (swapr-l))  ; also calls drawlines
      ((= pt2 nil) (quit))
    )
    (setvar 'osmode oldsnap)
    (initget 6 "Swap")
  )

  (setq x 0)
  (repeat (- (sslength ssp) 1)
    (setvar 'filletrad 0)
    (command "fillet" (ssname ssp x) (ssname ssp (1+ x)))
    (setq x (1+ x))
  )

  (setq x 0)
  (command "pedit" (entlast) "Y" "J")
  (repeat (- (sslength ssp) 1)
    (command (ssname ssp x))
    (setq x (1+ x))
  )
  (command "" "")

  (princ)

)
(ah:ploffs)






« Last Edit: August 27, 2019, 06:29:41 AM by BIGAL »
A man who never made a mistake never made anything

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Draw a polyline with a certain offset
« Reply #20 on: August 27, 2019, 08:46:28 AM »
FWIW: Here is my attempt. For now it will only work in the WCS and for 'WCS' polylines.
Code - Auto/Visual Lisp: [Select]
  1. (defun KGA_List_LastRemove (lst)
  2.   (reverse (cdr (reverse lst)))
  3. )
  4.  
  5. (defun OffsetSegments_NewSegment (poly pt dis / param ptOn vec) ; Pt is point near segment on the offset side.
  6.   (setq param (vlax-curve-getparamatpoint poly ptOn))
  7.   (setq vec (polar '(0.0 0.0 0.0) (angle ptOn pt) dis))
  8.   (list
  9.     (KGA_List_LastRemove (mapcar '+  vec (vlax-curve-getpointatparam poly (fix param))))
  10.     (KGA_List_LastRemove (mapcar '+  vec (vlax-curve-getpointatparam poly (fix (1+ param)))))
  11.   )
  12. )
  13.  
  14. (defun OffsetSegments_Inters (segm1 segm2)
  15.   (apply 'inters (append segm1 segm2 '(nil)))
  16. )
  17.  
  18. (defun c:OffsetSegments ( / doc dis new oldOsm poly pt ptLst segmLst)
  19.  
  20.   (defun *error* (msg)
  21.     (if oldOsm (setvar 'osmode oldOsm))
  22.     (if doc (vla-endundomark doc))
  23.   )
  24.  
  25.   (if
  26.     (and
  27.       (setq poly (car (entsel)))
  28.       (setq poly (vlax-ename->vla-object poly))
  29.       (= "AcDbPolyline" (vla-get-objectname poly))
  30.       (setq dis (getdist "\nOffset distance: "))
  31.     )
  32.     (progn
  33.       (setq oldOsm (getvar 'osmode))
  34.       (setvar 'osmode 0)
  35.       (while (setq pt (getpoint "\nPick offset side for each segment (close to segment) or Enter: "))
  36.         (setq ptLst (cons pt ptLst))
  37.       )
  38.       (setvar 'osmode oldOsm)
  39.       (setq segmLst
  40.         (mapcar
  41.           '(lambda (pt) (OffsetSegments_NewSegment poly pt dis))
  42.           ptLst
  43.         )
  44.       )
  45.       (setq ptLst
  46.         (apply
  47.           'append
  48.           (mapcar
  49.             '(lambda (prev cur next / int)
  50.               (cond
  51.                 ((not prev) ; Start segment: return startpoint only
  52.                   (setq int (OffsetSegments_Inters cur next))
  53.                   (if (> (distance int (car cur)) (distance int (cadr cur))) ; Distance check is not always reliable.
  54.                     (list (car cur))
  55.                     (list (cadr cur))
  56.                   )
  57.                 )
  58.                 ((not next) ; End segment: return intersection and endpoint.
  59.                   (setq int (OffsetSegments_Inters prev cur))
  60.                   (if (> (distance int (car cur)) (distance int (cadr cur)))
  61.                     (list int (car cur))
  62.                     (list int (cadr cur))
  63.                   )
  64.                 )
  65.                 (T
  66.                   (list (OffsetSegments_Inters prev cur))
  67.                 )
  68.               )
  69.             )
  70.             (cons nil segmLst)
  71.             segmLst
  72.             (append (cdr segmLst) '(nil))
  73.           )
  74.         )
  75.       )
  76.       (setq new (vla-copy poly))
  77.       (vla-put-closed new :vlax-false)
  78.       (vlax-put new 'coordinates (apply 'append ptLst))
  79.     )
  80.   )
  81.   (princ)
  82. )
« Last Edit: August 27, 2019, 08:50:07 AM by roy_043 »

Coder

  • Swamp Rat
  • Posts: 827
Re: Draw a polyline with a certain offset
« Reply #21 on: August 27, 2019, 09:39:10 AM »
Thank you BIGAL, your codes works for me.

Thank you roy_43 for your second attempt, it works very well and professionally.

Have a great day for you all.