Pline help

Does someone have a routine that will create a new pline on top of an existing one & add supplemental segments/vertices throughout based on specfied segment lengths?

 

I don't know of one, but would the DIVIDE or MEASURE commands help at all?
There may be other ways to skin whatever cat you're attempting to deal with
.....
___

 

Paul - I don't think the measure or divide command would help. I'm trying to create a rather complex hatch boundary that consists of numerous curves & acad doesn't like when trying to hatch. I can set my osnap to near & trace the limits w/ pline segments & it'll hatch just fine because it consists of just line segments...but it gets to be too time consuming. Any ideas?

 

See my post to you at theSwamp.....

 

thanks Jeff i'll check over there

 

What's the SWAMP?

 

www.theSwamp.org
Another good place for help with all things Acad related & socializing in
general, as is www.cadvault.com

 

Hi Jeff

Couldn't keep my fingers from...

Code:

;|Function to add supplemental vertices to a LWPolyline at a user specified
distance.
by Jeff Mishler, December 2004
edited by Jürg Menzi, December 2004 (bulge support added etc.)
Adds vertices as well as retains all original vertices.
|;
(defun C:More_Segs ( / AcaDoc BlgIdx BlgLst CurBlg CurLen CurObj CurRad CurSet
ExLoop FstPnt FstTpt NewCor NewPol NxtPar NxtPnt NxtTpt
OldCor OldLen SegCnt TmpBlg TmpDst TmpStr)
(if (setq CurSet (ssget "_:S:L" '((0 . "LWPOLYLINE"))))
(progn
(vl-load-com)
(or Me:Dst (setq Me:Dst 10.0))
(setq AcaDoc (vla-get-ActiveDocument (vlax-get-acad-object))
CurObj (vlax-ename->vla-object (ssname CurSet 0))
CurLen (vlax-curve-getDistAtParam
CurObj
(vlax-curve-getEndParam CurObj)
)
)
(vla-StartUndoMark AcaDoc)
(while (not ExLoop)
(initget 6)
(setq TmpStr (strcat
"\nNew distance between vertices <"
(rtos Me:Dst)
">: "
)
Me:Dst (cond ((getdist TmpStr)) (Me:Dst))
)
(if (< Me:Dst CurLen)
(setq ExLoop T)
(princ "Distance is greater or equal than pline length!")
)
)
(setq NewPol (vla-Copy CurObj)
OldCor (MeDoubleUp (vlax-get NewPol "Coordinates"))
FstPnt (car OldCor)
OldCor (if (= (vla-get-closed NewPol) :vlax-true)
(reverse (cons FstPnt (reverse OldCor)))
OldCor
)
NewCor (list FstPnt)
OldCor (cdr OldCor)
OldLen (length OldCor)
TmpDst Me:Dst
SegCnt 0
BlgIdx 0
)
(repeat OldLen
(setq NxtPnt (car OldCor)
FstTpt FstPnt
OldCor (cdr OldCor)
CurBlg (vla-GetBulge NewPol SegCnt)
CurRad (MeCalcRad CurBlg (distance FstPnt NxtPnt))
SegCnt (1+ SegCnt)
NxtPar (if (= SegCnt OldLen)
(vlax-curve-getEndParam NewPol)
(vlax-curve-getparamatpoint NewPol NxtPnt)
)
)
(while (and
(setq NxtTpt (vlax-curve-getpointatdist NewPol TmpDst))
(< (vlax-curve-getParamAtPoint NewPol NxtTpt) NxtPar)
)
(setq NxtTpt (list (car NxtTpt) (cadr NxtTpt))
NewCor (cons NxtTpt NewCor)
TmpBlg (MeCalcBulge CurRad (distance FstTpt NxtTpt) (minusp CurBlg))
BlgLst (cons (cons BlgIdx TmpBlg) BlgLst)
BlgIdx (1+ BlgIdx)
TmpDst (+ TmpDst Me:Dst)
FstTpt NxtTpt
)
)
(setq NewCor (cons NxtPnt NewCor)
TmpBlg (MeCalcBulge CurRad (distance FstTpt NxtPnt) (minusp CurBlg))
BlgLst (cons (cons BlgIdx TmpBlg) BlgLst)
BlgIdx (1+ BlgIdx)
FstPnt NxtPnt
)
)
(setq NewCor (apply 'append (reverse NewCor)))
(vlax-put NewPol "Coordinates" NewCor)
(mapcar '(lambda (l) (vla-SetBulge NewPol (car l) (cdr l))) (reverse BlgLst))
(initget "Yes No")
(setq TmpStr (getkword "\nDelete original Pline? [Yes/No] <Yes>: "))
(if (not (eq TmpStr "No")) (vla-delete CurObj))
(vla-EndUndoMark AcaDoc)
)
)
(princ)
)
;
; == Function MeDoubleUp
; Converts a list to an double point list.
; Arguments [Type]:
;   Lst = List to convert, eg. '(1 2 3 4 5 6) [LIST]
; Return [Type]:
;   > Coverted list '((1 2)(3 4)(5 6)) [LIST]
; Notes:
;   Credits to Ken Alexander
;
(defun MeDoubleUp (Lst / RetLst TmpLst)
(if (setq TmpLst Lst)
(while
(setq RetLst (cons (list (car TmpLst) (cadr TmpLst)) RetLst)
TmpLst (cddr TmpLst)
)
)
)
(reverse RetLst)
)
;
; == Function MeCalcRad
; Calculates the radius from bulge and chord length.
; Arguments [Type]:
;   Blg = Bulge [REAL]
;   Dst = Chord length [REAL]
; Return [Type]:
;   > Radius [REAL]
; Notes:
;   None
;
(defun MeCalcRad (Blg Dst)
(if (/= Blg 0)
(abs (/ (/ Dst 2.0) (sin (* 2.0 (atan Blg)))))
0.0
)
)
;
; == Function MeCalcBulge
; Calculates the bulge from radius and chord length.
; Arguments [Type]:
;   Blg = Radius [REAL]
;   Dst = Chord length [REAL]
;   Dir = Bulge direction (T = negative) [BOOLEAN]
; Return [Type]:
;   > Bulge [REAL]
; Notes:
;   None
;
(defun MeCalcBulge (Rad Dst Dir / HlfCho TmpBlg)
(setq HlfCho (/ Dst 2.0)
TmpBlg (if (/= Rad 0)
(/ (- Rad (Sqrt (- (expt Rad 2) (expt HlfCho 2)))) HlfCho)
0.0
)
)
(if Dir (- TmpBlg) TmpBlg)
)

Cheers