Convert Any Length Arc into Equal Segments

[EricDevault]

You could perform them using a macro if you wish:

 

^C^C_copyclip;_seamslice;_autonest;

YES! worked, awesome

[Lee Mac]

YES! worked, awesome

 

Excellent

[gilsoto13]

Excellent

 

 

That's what I mean...it works even with polylines... incrediboul...

 

 

Now I can find many applications for this routine... specially for format converting...pdfs.. corel draw... 3ds...

 

You know I am gonna pay... but it will be "payment in kind"...

[Lee Mac]

That's what I mean...it works even with polylines... incrediboul...

 

 

Now I can find many applications for this routine... specially for format converting...pdfs.. corel draw... 3ds...

 

You know I am gonna pay... but it will be "payment in kind"...

 

Thanks, yeah, it should work with Arcs, Polylines, Circles, Ellipses, etc

 

But for closed Entities like Circles/Ellipses, I think you may get a slight 'overlap'

[rochel1280]

can u teach me how to use this lsp?

please....

[Lee Mac]

http://www.cadtutor.net/forum/showthread.php?t=1390

[bchunky]

Try arctolines.com. Someone made a plugin that might be useful.

[bchunky]

I have made a vlx plug for this that has options for path and slicing. Please try it out. http://www.arctolines.com ...would appreciate some feedback. Thanks!

[CADMASTER1128]

Lee Mac,

 

With the LISP you have posted here, can it be modified to take a POLYLINE and segment it at a certain distance?

 

i.e. - I have a curving boardwalk that I need to segment every 10' on the outside curves, is that something that can be done?

 

[gilsoto13]

Hi, CADMASTER:

 

I guess you already know that what you're trying to do is something that can be accomplished with the Divide command.

[CADMASTER1128]

Hi, CADMASTER:

 

I guess you already know that what you're trying to do is something that can be accomplished with the Divide command.

 

I know about he divide command, but that just breaks an object into equal segments, I want to take an about object (i.e. 138'-9'' arc or POLYLINE length) and break it into as many 10'-0'' as I can. Does that make sense?

[ROBP]

I am looking for a routine to convert arcs into equal segments and join it into a polyline. rather than converting all arcs, a prompt to select various arcs would be helpful, and a promt for number of segments. I have this one lisp routine but it doesnt work with the prototype we load at the beginning of autocad.

 

 

What is the purpose of dividing it and then join them?

[ROBP]

I know about he divide command, but that just breaks an object into equal segments, I want to take an about object (i.e. 138'-9'' arc or POLYLINE length) and break it into as many 10'-0'' as I can. Does that make sense?

 

 

Nop it does'nt make sense

[gilsoto13]

Well, if you're looking for the routine, one of our Experts could help, but if you just need to solve this issue for now, obviously you can use the divide command and I guess you don´t need to know how to use it for this case, or do you?

[gilsoto13]

Please tell me that you know how to get 10' equal segments using the divide command

[CADMASTER1128]

Please tell me that you know how to get 10' equal segments using the divide command

 

I was actually able to achieve the same results using the MEASURE command.

[chamberz]

First off, I just discovered LISPs this afternoon (after using AutoCad for over 15 years), the code you provided Mr. Mac works almost perfectly for what I am looking for, but it flattens my contours/polylines so they are all on the same Z elevation. Is there any small tweak to make it not do that? I know this is an old thread, so I hope you still monitor it. As a couple other people have mentioned, I need to take a bunch of polylines and segment each one out so they are made up of similar length segments (e.g., 10').

 

Thanks!

Matt

 

Perhaps something like this? Might need a bit of refining for closed entities:

 

(defun c:Segs (/ CLEN ENT I J PTS SEGNUM SS)
 (vl-load-com) ; Lee Mac  ~  30.01.10

 (setq *doc  (cond (*doc) ((vla-get-ActiveDocument (vlax-get-acad-object))))        
       *sLen (cond (*sLen) (10.)))

 (if (and (setq j -1 ss (ssget "_:L" '((0 . "ARC,CIRCLE,*POLYLINE,SPLINE,LINE,ELLIPSE"))))
          (not (initget 6))
          (setq *sLen (cond ((getdist (strcat "\nSpecify Segment Length <"
                                              (rtos *sLen) "> : "))) (*sLen))))
   
   (while (setq ent (ssname ss (setq j (1+ j))))
     (vla-StartUndoMark *doc)

     (setq cLen (vlax-curve-getDistAtParam ent
                  (vlax-curve-getEndParam ent)) segNum (fix (/ cLen *sLen)) i -1)

     (or (zerop (rem cLen *sLen)) (setq segNum (1+ segNum)))

     (repeat (1+ segNum)
       (setq pts (cons (cond ((vlax-curve-getPointAtDist ent
                                (* (setq i (1+ i)) *sLen)))
                             ((vlax-curve-getEndPoint ent)))  pts)))
     
     (entmake (append (list (cons 0   "LWPOLYLINE")
                            (cons 100 "AcDbEntity")
                            (cons 100 "AcDbPolyline")
                            (cons 90 (length pts))
                            (cons 70 0))
                      (mapcar (function (lambda (a) (cons 10 a))) pts)))
     
     (entdel ent) (setq pts nil)
     (vla-EndUndoMark *doc)))

 (princ))

[mousho]

Hi,

 

Here's a routine I wrote some times ago.

I works with arcs, circles and polylines arcs

 

(defun c:Arc2Seg (/ arc2pol pol2pol seg del org ss n ent elst)

(vl-load-com)

 ;; Returns the polyline DXF list (form an arc or a circle)
 (defun arc2pol
    (elst seg org / closed alpha delta cen elv rad lay nlst)
   (and (= (cdr (assoc 0 elst)) "CIRCLE") (setq closed T))
   (setq alpha    (if closed
         (* pi 2)
         (cdr (assoc 51 elst))
       )
     delta    (if closed
         (/ alpha seg)
         (/ (ang<2pi (- alpha (cdr (assoc 50 elst)))) seg)
       )
     cen    (cdr (assoc 10 elst))
     elv    (caddr cen)
     cen    (list (car cen) (cadr cen))
     rad    (cdr (assoc 40 elst))
     lay    (if org
         (assoc 8 elst)
         (cons 8 (getvar "CLAYER"))
       )
     nlst    (vl-remove-if-not
         (function (lambda (x) (member (car x) '(210 -3))))
         elst
       )
     nlst    (cons (cons 10 (polar cen alpha rad)) nlst)
   )
   (repeat (if    closed
         (1- seg)
         seg
       )
     (setq
   nlst (cons (cons 10
            (polar cen (setq alpha (- alpha delta)) rad)
          )
          nlst
        )
     )
   )
   (setq nlst
      (cons '(0 . "LWPOLYLINE")
        (cons '(100 . "AcDbEntity")
              (cons (cons 410 (getvar "CTAB"))
                (cons lay
                  (cons '(100 . "AcDbPolyline")
                    (cons (cons 90
                            (if closed
                              seg
                              (1+ seg)
                            )
                          )
                          (cons (cons 70
                              (if closed
                                1
                                0
                              )
                            )
                            (cons (cons 38 elv) nlst)
                          )
                    )
                  )
                )
              )
        )
      )
   )
 )

 ;; Returns the polyline DXF list (form a polyline)
 (defun pol2pol (elst    seg   org   /      cnt    closed        nlst  p0
         p1    p2    bu    larg  inc    bdata delta cen      rad
         alpha    n
        )
   (setq closed (logand 1 (cdr (assoc 70 elst)))
     cnt     0
   )
   (and (= closed 1) (setq p0 (cdr (assoc 10 elst))))
   (while elst
     (if (= (caar elst) 10)
   (progn
     (setq    p1 (cdar elst)
       p2 (cdr (assoc 10 (cdr elst)))
       bu (cdr (assoc 42 elst))
     )
     (cond
       ((or (= 0 bu)
        (and (zerop closed) (null p2))
        )
        (setq nlst    (cons (cadddr elst)
                 (cons (caddr elst)
                   (cons (cadr elst)
                     (cons (car elst) nlst)
                   )
                 )
           )
        )
       )
       ((and p2 (/= 0 bu) (<= (distance p1 p2) mini))
        (setq nlst    (cons (caddr elst)
                   (cons (cadr elst)
                     (cons (car elst) nlst)
                   )
                 )
        )
       )
       (T
        (and (not p2) (= closed 1) (setq p2 p0))
        (setq larg     (cdr (assoc 40 elst))
          inc     (/ (- (cdr (assoc 41 elst)) larg) seg)
          bdata (BulgeData bu p1 p2)
          delta (/ (car bdata) seg)
          rad     (abs (cadr bdata))
          cen     (caddr bdata)
          alpha (angle cen p1)
          n     0
          cnt     (+ cnt seg -1)
        )
        (while (< n seg)
          (setq nlst (cons
               (cons 10
                 (polar cen
                    (+ alpha (* delta n))
                    rad
                 )
               )
               nlst
             )
            nlst (cons (cons 40 larg) nlst)
            nlst (cons (cons 41 (setq larg (+ larg inc))) nlst)
            nlst (cons '(42 . 0.0) nlst)
            n      (1+ n)
          )
        )
       )
     )
     (setq elst (cddddr elst))
   )
   (setq nlst (cons (car elst) nlst)
         elst (cdr elst)
   )
     )
   )
   (or    org
   (setq nlst (subst (cons 8 (getvar "CLAYER")) (assoc 8 nlst) nlst))
   )
   ((lambda (dxf90)
      (subst (cons 90 (+ (cdr dxf90) cnt))
         dxf90
         (reverse (subst '(42 . 0.0) (assoc 42 nlst) nlst))
      )
    )
     (assoc 90 nlst)
   )
 )

 ;; Main

 (or (getenv "SegmentsNumberPerCircle")
     (setenv "SegmentsNumberPerCircle" "64")
 )
 (initget 6)
 (or (setq mini (getdist "\nMinimal length for a segment: "))
     (setq mini 0.5)
 )
 (initget 6)
 (if
   (setq seg (getint
       (strcat    "\nNumber of segments per arc <"
           (getenv "SegmentsNumberPerCircle")
           ">: "
       )
         )
   )
    (setenv "SegmentsNumberPerCircle" (itoa seg))
    (setq seg (atoi (getenv "SegmentsNumberPerCircle")))
 )
 (initget "Yes No")
 (if (= "Yes"
    (getkword "\nErase source objects ? Yes/No <N>: ")
     )
   (setq del T)
 )
 (initget "Current Source")
 (if (= "Origine"
    (getkword
      "\nLayer for new objects [Current/Source] ? <C>: "
    )
     )
   (setq org T)
 )
 (prompt
   "\nSelect objects or <all>."
 )
 (and
   (or    (setq ss (ssget '((0 . "ARC,CIRCLE,LWPOLYLINE"))))
   (setq ss (ssget "_X" '((0 . "ARC,CIRCLE,LWPOLYLINE"))))
   )
   (setq n 0)
   (while (setq ent (ssname ss n))
     (setq elst (entget ent '("*")))
     (if (= (cdr (assoc 0 elst)) "LWPOLYLINE")
   ((if del
      entmod
      entmake
    )       (pol2pol elst seg org)
   )
   (progn
     (entmake (arc2pol elst seg org))
     (and del (entdel ent))
   )
     )
     (setq n (1+ n))
   )
 )
 (princ)
)


;; BulgeData
;; Retourne les données d'un polyarc (angle rayon centre)
(defun BulgeData (bu p1 p2 / alpha rad cen)
 (setq    alpha (* 2 (atan bu))
   rad   (/ (distance p1 p2)
        (* 2 (sin alpha))
         )
   cen   (polar p1
            (+ (angle p1 p2) (- (/ pi 2) alpha))
            rad
         )
 )
 (list (* alpha 2.0) rad cen)
)

;;; Ang<2pi
;;; Retourne l'angle, �* 2*k*pi près, compris entre 0 et 2*pi

(defun ang<2pi (ang)
 (if (and (<= 0 ang) (< ang (* 2 pi)))
   ang
   (ang<2pi (rem (+ ang (* 2 pi)) (* 2 pi)))
 )
)

 

 

HI GILE

great lisp, there is anyway that we can change the lisp that the length of the new line will be the exact length that u anter?

[Sariah]

What is the order we should writ to apply this lisp?

[BIGAL]

It sounds like you know nothing about running a lisp program, so Google

"Running lisp programs Autocad" 

"Use appload to load lisp"

 

The answer to your question is "Arc2seg" but Google 1st.