Topic: Pline question

[bman]

Is there a way to create a mutli-segmented pline at specified segment lengths from an existing pline?

[PDJ]

Do you mean like starting the pline from the existing one, then lie 3@45, then 5@67 where 3 or 5 is the distance and 45 or 67 are the angles??  Or are you talking about a whole different beast here??

[CAB]

Are you creating a new pline or trying to join to the existing pline?
How are you determining the next point? You say you have a specific distance
but you need a direction as well.
Is the user picking the direction and not the distance?

[bman]

i'm trying to create a new pline on top of an existing one that will create supplemental vertices based on specfied segment lengths in an effort to create a hatch boundary for an internal road that has alot of curves & reverse curves. I've always had difficulty hatching when this occurs. I've changed the snapbase w/o any luck. If i trace the outline with pline segments w/ my osnap set to near it comes out perfect every time....it's just so time consuming.

[Jeff_M]

Here ya go. I've provided options for the segment length and whether to keep the original pline.

Code: [Select]


;|Function to add supplemental vertices to a LWPolyline at a user specified distance.
  by Jeff Mishler, December 2004
  Currently is for use only in Modelspace but could be modified to use the current space.
  Adds vertices as well as retains all original vertices.
|;

(defun c:more_segs (/ DIST ENDPT NEW-COORDS NEWPLINE NEXTPARAM OBJ OLD-COORDS
     SS TMP TMP_PT XY Z DOC close-dist ans)
  (if (setq ss (ssget ":S" '((0 . "LWPOLYLINE"))))
    (progn
      (or sup-dist (setq sup-dist 10.0))
      (setq tmp (getdist (strcat "\nNew distance between vertices?<" (rtos sup-dist) ">: ")))
      (if tmp (setq sup-dist tmp))
      (setq obj (vlax-ename->vla-object (ssname ss 0)))
      (if (eq (vla-get-closed obj) :vlax-true)
(progn
 (setq closed t)
 (vla-put-closed obj :vlax-false)
 )
)
      (setq doc (vla-get-activedocument (vlax-get-acad-object))
   old-coords (vlax-get obj "coordinates")
   xy (list (car old-coords)(cadr old-coords))
   z (vla-get-elevation obj)
   new-coords xy
   tmp_pt xy
   old-coords (cdr (cdr old-coords))
   endPt (vlax-curve-getendpoint obj)
   dist 0
   )
      (setq dist (+ dist sup-dist))
      (while (not (equal (list (car xy) (cadr xy) z) endPt))
(setq xy (list (car old-coords)(cadr old-coords))
     nextparam (vlax-curve-getparamatpoint obj xy)
     )
(if old-coords
 (setq old-coords (cdr (cdr old-coords)))
 )
(while (and (vlax-curve-getparamatdist obj dist)
   (< (vlax-curve-getparamatdist obj dist) nextparam)
   )
 (setq tmp_pt (vlax-curve-getpointatdist obj dist)
new-coords (append new-coords (list (car tmp_pt)(cadr tmp_pt)))
)
 (setq dist (+ dist sup-dist))
 )
(setq new-coords (append new-coords (list (car xY) (cadr xy))))
)
      (if (and closed
      (< sup-dist (setq close-dist (distance endPt (vlax-curve-getstartpoint obj))))
      )
(progn
 (setq tmp_pt endpt
ang (angle endPt (vlax-curve-getstartpoint obj)))
 (repeat (fix (/ close-dist sup-dist))
   (setq tmp_pt (polar tmp_pt ang sup-dist))
   (setq new-coords (append new-coords (list (car tmp_pt)(cadr tmp_pt))))
   )
 )
)
      (setq newpline (vlax-invoke (vla-get-modelspace doc) "AddLightweightPolyline" new-coords))
      (vla-put-layer newpline (vla-get-layer obj))
      (vla-put-elevation newpline z)
      (if closed
(progn
 (vla-put-closed obj :vlax-true)
 (vla-put-closed newpline :vlax-true)
 )
)
      (initget "Yes No")
      (setq ans (getkword "\nDelete original Pline?<No>: "))
      (if (and ans
      (eq ans "Yes"))
(vla-delete obj)
)
      )
    )
  (princ)
  )


edited to allow for removal of original pline and to work with closed plines. Although it only assumes a straight closing segment.

[bman]

thanks Jeff.
it worked to perfection!

[Jeff_M]

You're welcome.
Here's a revised version that works correctly with closed plines having an arc for the last segment. It will also place the new pline in the same space as the one selected (previously, if you selected a pline in Paperspace the new one would be drawn in Modelspace).

Code: [Select]


;|Function to add supplemental vertices to a LWPolyline at a user specified distance.
  by Jeff Mishler, December 2004
  ver. 1.01 - added code to work properly with closed plines having an arc as the closing segment,
  and to place the new pline in the current space
  Adds vertices as well as retains all original vertices.
|;

(defun c:more_segs (/ dist endpt new-coords newpline nextparam obj old-coords
     ss tmp tmp_pt xy z doc close-dist ans space)
  (if (setq ss (ssget ":S" '((0 . "LWPOLYLINE"))))
    (progn
      (or sup-dist (setq sup-dist 10.0))
      (setq tmp (getdist (strcat "\nNew distance between vertices?<" (rtos sup-dist) ">: ")))
      (if tmp (setq sup-dist tmp))
      (setq obj (vlax-ename->vla-object (ssname ss 0)))
      (setq doc (vla-get-activedocument (vlax-get-acad-object))
   old-coords (vlax-get obj "coordinates")
   z (vla-get-elevation obj)
   new-coords (list (car old-coords)(cadr old-coords))
   tmp_pt new-coords
   old-coords (cdr (cdr old-coords))
   endPt (vlax-curve-getendpoint obj)
   dist 0
   )
      (setq space
    (if (= 1 (vla-get-activespace doc))
      (vla-get-modelspace doc);we're in modelspace
      (if (= (vla-get-mspace doc) :vlax-true)
(vla-get-modelspace doc);we're in modelspace thru paperspace VPort
(vla-get-paperspace doc);we're in paperspace
)
      )
   )
      (if (= (vla-get-closed obj) :vlax-true)
(setq old-coords (append old-coords (list (car endpt) (cadr endpt))))
)
      (setq dist (+ dist sup-dist))
      (while old-coords
(setq xy (list (car old-coords)(cadr old-coords)))
(if (= (length old-coords) 2)
 (setq nextparam (vlax-curve-getendparam obj))
 (setq nextparam (vlax-curve-getparamatpoint obj xy))
 )
(setq old-coords (cdr (cdr old-coords)))
(while (and (vlax-curve-getparamatdist obj dist)
   (< (vlax-curve-getparamatdist obj dist) nextparam)
   )
 (setq tmp_pt (vlax-curve-getpointatdist obj dist)
new-coords (append new-coords (list (car tmp_pt)(cadr tmp_pt)))
)
 (setq dist (+ dist sup-dist))
 )
(setq new-coords (append new-coords (list (car xY) (cadr xy))))
)
      (setq newpline (vlax-invoke space "AddLightweightPolyline" new-coords))
      (vla-put-layer newpline (vla-get-layer obj))
      (vla-put-elevation newpline z)
      (vla-put-closed newpline (vla-get-closed obj))
      (initget "Yes No")
      (setq ans (getkword "\nDelete original Pline?<No>: "))
      (if (and ans
      (eq ans "Yes"))
(vla-delete obj)
)
      )
    )
  (princ)
  )

 

[bman]

thanks again!