+ Reply to Thread
Results 1 to 6 of 6
  1. #1
    Forum Newbie
    Using
    Civil 3D 2012
    Join Date
    Feb 2012
    Posts
    2

    Default Convert polyline with arc to polyline with straight lines.

    Registered forum members do not see this ad.

    Hi all - I created a lightweight polyline by filleting two straight polylines to create 1 polyline that contains an arc. I would like to convert the arc into a series of straight polylines that mimic the original shape of the arc, while not disturbing the straight parts of the polyline. I found a .lsp routine that does this perfectly, but it only works for the older heavyweight polylines. Can anyone help modify this routine so it works for lightweight polylines or provide another suggestion? Id rather not convert to heavyweight, use the routine, and convert back to lightweight. Thanks so much!

    Here is the code:

    Code:
    ;;;Translate plines w/ arcs to plines w/ mult. straight segments for use
    ;;;with DTM TIN's for contouring.  Rounds out pline arcs via a suitable no.
    ;;;of straight segments.  The determiner is based on small angle deflection.
    ;;;
    ;;;	AUTHOR: HENRY C. FRANCIS
    ;;;		425 N. ASHE ST.
    ;;;		SOUTHERN PINES, NC 28387
    ;;;
    ;;;		All rights reserved without prejudice.
    ;;;
    ;;;	Copyright:	5-10-96
    ;;;	Edited:		10-1-98
    ;;;
    (DEFUN c:plxl (/ found)
      (SETQ	osmod (GETVAR "osmode")
    	fltot 0
    	incrn 0
      ) ;_ end of setq
      (SETVAR "osmode" 0)
      (SETQ	usrdeg (ureal 1
    		      ""
    		      "Deflection angle (< 5 degrees)"
    		      (IF usrdeg
    			usrdeg
    			5.0
    		      ) ;_ end of if
    	       ) ;_ end of ureal
      ) ;_ end of setq
      (SETQ usrrad (* (/ usrdeg 180.0000) PI))
      (SETQ pliness (SSGET '((0 . "POLYLINE"))))
      (IF pliness
        (PROGN
          (COMMAND ".undo" "m")
          (SETQ plinesslen
    	     (SSLENGTH pliness)
    	    sscount 0
          ) ;_ end of setq
          (WHILE (< sscount plinesslen)
    	(SETQ currpline (SSNAME pliness sscount))
    	(SETQ plent (ENTGET currpline))
    	(SETQ plvert (ENTGET (ENTNEXT (CDAR plent))))
    	(PROGN
    	  (ENTMAKE
    	    (LIST
    	      (ASSOC 0 plent)
    	      (ASSOC 8 plent)
    	      (ASSOC 66 plent)
    	      (ASSOC 10 plent)
    	      (ASSOC 70 plvert)
    	    ) ;_ end of list
    	  ) ;_ end of entmake
    	  (ENTMAKE
    	    (LIST
    	      (ASSOC 0 plvert)
    	      (ASSOC 10 plvert)
    	    ) ;_ end of list
    	  ) ;_ end of entmake
    ;;;----repeat this until the end of the polyline
    	  (WHILE (/= (CDR (ASSOC 0 (ENTGET (ENTNEXT (CDAR plvert)))))
    		     "SEQEND"
    		 ) ;_ end of /=
    ;;;------if it begins an arc segment
    	    (IF	(/= (CDR (ASSOC 42 plvert)) 0)
    ;;;--------do this
    	      (PROGN
    		(SETQ found T)
    		(SETQ plnvert (ENTGET (ENTNEXT (CDAR plvert))))
    		(SETQ strt40 (CDR (ASSOC 40 plvert)))
    		(SETQ end41 (CDR (ASSOC 41 plvert)))
    		(SETQ fpt1 (CDR (ASSOC 10 plvert)))
    		(SETQ fpt2 (CDR (ASSOC 10 plnvert)))
    		(SETQ chrdl (DISTANCE fpt1 fpt2))
    		(SETQ theta (ATAN (CDR (ASSOC 42 plvert))))
    		(SETQ psi (- (/ PI 2) (ABS theta)))
    		(SETQ phi (* (ABS theta) 4))
    		(SETQ chang (ANGLE fpt1 fpt2))
    		(SETQ arcr (ABS	(/ (* (DISTANCE fpt1 fpt2) (SIN psi))
    				   (* 2 (COS theta) (SIN (* 2 theta)))
    				) ;_ end of /
    			   ) ;_ end of abs
    		) ;_ end of setq
    		(SETQ arcc
    		       (IF (> theta 0)
    			 (POLAR fpt1 (+ (- chang theta) psi) arcr)
    			 (POLAR fpt1 (- (- chang theta) psi) arcr)
    		       ) ;_ end of if
    		) ;_ end of setq
    		(SETQ fenl    (* phi arcr)
    		      count   (1+ (FIX (/ phi usrrad)))
    		      plwinc  (/ (- strt40 end41) count)
    		      plwe    (+ strt40 plwinc)
    		      incra   (/ phi count)
    		      incrn   0
    		      initang (ANGLE arcc fpt1)
    		) ;_ end of setq
    		(WHILE
    		  (> count 0)
    		   (SETQ incrn (1+ incrn))
    		   (SETQ plwb plwe
    			 plwe (- plwe plwinc)
    		   ) ;_ end of setq
    		   (IF (< theta 0)
    		     (SETQ fpt4
    			    (POLAR arcc (- initang (* incrn incra)) arcr)
    		     ) ;_ end of setq
    		     (SETQ fpt4
    			    (POLAR arcc (+ initang (* incrn incra)) arcr)
    		     ) ;_ end of setq
    		   ) ;_ end of if
    		   (PROGN
    		     (ENTMAKE
    		       (LIST
    			 (CONS 0 "VERTEX")
    			 (ASSOC 8 plvert)
    			 (CONS 10 fpt4)
    		       ) ;_ end of list
    		     ) ;_ end of entmake
    		     (GRDRAW fpt1 fpt4 -1)
    		   ) ;_ end of progn
    		   (SETQ fpt1  fpt4
    			 count (1- count)
    		   ) ;_ end of setq
    		) ;_ end of while
    		(SETQ plvert (ENTGET (ENTNEXT (CDAR plvert))))
    	      ) ;_ end of progn
    ;;;--------or else it begins a line segment so do this
    	      (PROGN
    		(SETQ fpt1 (CDR (ASSOC 10 plvert)))
    		(SETQ fpt2
    		       (CDR (ASSOC 10 (ENTGET (ENTNEXT (CDAR plvert)))))
    		) ;_ end of setq
    		(SETQ fenl (DISTANCE fpt1 fpt2))
    		(ENTMAKE
    		  (LIST
    		    (CONS 0 "VERTEX")
    		    (ASSOC 8 plvert)
    		    (CONS 10 fpt2)
    		  ) ;_ end of list
    		) ;_ end of entmake
    		(GRDRAW fpt1 fpt2 -1)
    		(SETQ fpt1 fpt2)
    		(SETQ plvert (ENTGET (ENTNEXT (CDAR plvert))))
    	      ) ;_ end of progn
    	    ) ;_ end of if
    	  ) ;_ end of while
    	  (IF found
    	    (PROGN
    	      (ENTMAKE
    		(LIST
    		  (CONS 0 "SEQEND")
    		) ;_ end of list
    	      ) ;_ end of entmake
                  (ENTDEL currpline)
    	    ) ;_ end of progn
    	    (PROGN
    	      (ENTMAKE)
    	      (COMMAND ".redraw")
    	      (PRINC "\nPolyline contains no arcs. ")
    	    ) ;_ end of progn
    	  ) ;_ end of if
    	) ;_ end of progn
    	(SETQ sscount (1+ sscount))
          ) ;_ end of WHILE
        ) ;_ end of progn
      ) ;_ end of if
      (PRINC)
    ) ;_ end of defun
    
    ;|«Visual LISP© Format Options» (72 2 40 2 T "end of " 60 9 2 0 0 T T nil T)
     ***Don't add text below the comment!***|;
    I also had to add this into AutoCAD to get it to work:

    Code:
    ;This function is freeware courtesy of the author's of "Inside AutoLisp" for rel. 10 published by New Riders Publications.  This credit must accompany all copies of this function.
    ;
    ;* UREAL User interface real function 
    ;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET.
    ;* MSG is the prompt string, to which a default real is added as <DEF> (nil
    ;* for none), and a : is added.
    ;*
    (defun ureal (bit kwd msg def / inp)
      (if def 
        (setq msg (strcat "\n" msg " <" (rtos def 2) ">: ")
              bit (* 2 (fix (/ bit 2)))
        )
        (setq msg (strcat "\n" msg ": "))
      );if
      (initget bit kwd)
      (setq inp (getreal msg))
      (if inp inp def)
    );defun
    ;*
    (princ)
    ;*

  2. #2
    Forum Deity David Bethel's Avatar
    Discipline
    Multi-disciplinary
    David Bethel's Discipline Details
    Discipline
    Multi-disciplinary
    Details
    Commercial Food Service
    Using
    AutoCAD pre 2000
    Join Date
    Dec 2003
    Location
    Newport News, Virginia
    Posts
    2,055

    Default

    I've used lots of variations of this over the years:

    ARG -> PLINE ename
    RET -> LIST of point values

    Code:
    ;++++++++++++ FINDPATH +++++++++++++++++++++++++++++++++++++++++++
    ;;;Returns ECS Point Values Of PLINE
    (defun findpath (en / pl ed sp_flg cl_flg bf nl i vp bf vf pl_flg)
      (if (= "LWPOLYLINE" (cdr (assoc 0 (entget en))))
          (command "_.CONVERTPOLY" "_Heavy" en ""))
      (setq ed (entget en))
      (and (/= "POLYLINE" (cdr (assoc 0 ed)))
           (princ "\n*** POLYLINEs Only *** ")
           (exit))
      (setq pl_flg (cdr (assoc 70 ed)))
      (and (= (logand pl_flg 1) 1)
           (setq cl_flg T))
      (and (= (logand pl_flg 4) 4)
           (setq sp_flg T))
      (and (or (= (logand pl_flg 16) 16)
    	   (= (logand pl_flg 64) 64))
           (princ "\nInvalid POLYLINE Mesh")
           (exit))
      (while (/= "SEQEND" (cdr (assoc 0 (entget (entnext en)))))
    	 (setq en (entnext en)
    	       ed (entget en)
    	       vp (cdr (assoc 10 ed))
    	       bf (cdr (assoc 42 ed))
                   vf (cdr (assoc 70 ed)))
             (cond ((and (/= bf 0.0)
                         cl_flg
                         (= "SEQEND" (cdr (assoc 0 (entget (entnext en))))))
                    (add_arc vp (last pl) bf))
                   ((= "SEQEND" (cdr (assoc 0 (entget (entnext en)))))
                    (= bf 0.0)
                    (not cl_flg)
    		(setq pl (cons vp pl)))
                   ((and (/= bf 0.0)
                         (/= "SEQEND" (cdr (assoc 0 (entget (entnext en))))))
                    (add_arc vp (cdr (assoc 10 (entget (entnext en)))) bf))
    	       ((and (= bf 1.0)
    		     (not cl_flg)
    		     (= "SEQEND" (cdr (assoc 0 (entget (entnext en))))))
    		(princ))
    	       ((and sp_flg
    		     (= bf 0.0)
    		     (= (logand vf 8) 8))
    		(setq pl (cons vp pl)))
    	       ((and (not sp_flg)
    		     (= bf 0.0)
    		     (/= (logand vf 8) 8))
    		(setq pl (cons vp pl)))))
      (if (and cl_flg
    	   (not (equal (car pl) (last pl))))
          (setq pl (cons (last pl) pl)))
      (setq i 0)
      (while (< i (length pl))
    	 (while (equal (nth i pl) (nth (1+ i) pl) 0.0001)
    		(setq i (1+ i)))
    	 (and (nth i pl)
    	      (setq nl (cons (nth i pl) nl)))
    	 (setq i (1+ i)))
       nl)
    
    (defun add_arc (sp ep bulge / alist x1 x2 y1 y2 cotbce
    		ce ra sa ea ia inc qty na temp)
      (setq x1 (car sp);;Modified Bulge
    	x2 (car ep);;Conversion By
    	y1 (cadr sp);;Duff Kurland
    	y2 (cadr ep);;Autodesk, Inc.
        cotbce (/ (- (/ 1.0 bulge) bulge) 2.0)
    	ce (list (/ (+ x1 x2 (- (* (- y2 y1) cotbce))) 2.0)
    		 (/ (+ y1 y2	(* (- x2 x1) cotbce) ) 2.0)
    		 (caddr sp))
    	ra (distance ce sp)
    	sa (atan (- y1 (cadr ce)) (- x1 (car ce)))
    	ea (atan (- y2 (cadr ce)) (- x2 (car ce))))
      (if (minusp sa)
          (setq sa (+ sa (* 2.0 pi))))
      (if (minusp ea)
          (setq ea (+ ea (* 2.0 pi))))
      (if (minusp bulge)
          (setq temp sa sa ea ea temp))
      (if (> sa ea)
          (setq ia (+ (- (* pi 2.0) sa) ea))
          (setq ia (- ea sa)))
      (setq qty (max 2 (abs (fix (/ ia (/ pi 16) 2)))));;; SEGMENT QTY
      (setq na sa
           inc (/ (abs ia) qty))
      (repeat (1+ qty)
          (setq alist (cons (polar ce na ra) alist)
    	       na (+ sa inc)
    	       sa na))
      (if (not (equal sp (car alist) 0.0001))
          (setq alist (reverse alist)))
      (foreach a alist
          (setq pl (cons a pl))))
    Maybe it will help. -David
    R12 (Dos) - A2K

  3. #3
    Forum Deity pBe's Avatar
    Computer Details
    pBe's Computer Details
    Operating System:
    Windows XP
    Discipline
    Construction
    pBe's Discipline Details
    Discipline
    Construction
    Details
    Camp Construction planning and details
    Using
    AutoCAD 2009
    Join Date
    Apr 2010
    Posts
    2,633

    Default

    This edited sub routine might help you as well. a sub i used before for modified Xclip

    Code:
    (defun c:ArcToLine  (/ *error* blg blk ent objts cnt blgLoc pts stp mxp cur
           ent2d)
      (vl-load-com)
      (defun *error* (msg)
        (and uFlag (vla-EndUndoMark doc))
        (and ov (mapcar (function setvar) vl ov))
        (and msg
      (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
          (princ (strcat "\n** Error: " msg " **"))
      )
        )
        (princ)
      )
      (defun blg (ent num / blg)
        (repeat num
          (setq blg (cons (list
       (vla-getbulge ent (setq num (1- num)))
       (trans (vlax-safearray->list
         (variant-value
           (vla-Get-coordinate ent num)
         )
              )
              0
              1
       )
            )
            blg
      )
          )
        )
        
      )
      (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
     vl  '("CMDECHO" "OSMODE" "ORTHOMODE")
     ov  (mapcar (function getvar) vl)
      )
      (prompt "\nSelect LWPOLYLINE To convert:")
      (if
        (and
          (setq uFlag (not (vla-StartUndoMark doc)))
          (mapcar (function setvar) vl '(0 0 0))
          (setq pts nil ent (car (entsel "\nSelect Polyline Boundary:\n")))
          (eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
          (setq alen (getdist "\nEnter line ncrement length: "))
        )
         (progn
           (setq objts (vlax-ename->vla-object ent))
           (setq cnt    0   
          blgLoc (blg objts (cdr (assoc 90 (entget ent))))
           )
           (foreach itm blgLoc
      (setq cnt (1+ cnt))
      (if (= (car itm) 0.0)
        (setq pts (cons (trans (cadr itm) 1 0) pts))
        (progn
          (setq pts (cons (trans (cadr itm) 1 0) pts))
          (setq stp (if (zerop
            (setq cur (vlax-curve-getDistAtPoint
          objts
          (trans (cadr itm) 1 0)
               )
            )
          )
        (vla-get-length objts)
        cur
             )
         nxp (if (>= (1+ cnt) (cdr (assoc 90 (entget ent))))
        (vla-get-length objts)
        (vlax-curve-getDistAtPoint
          objts
          (trans (cadr (nth cnt blgLoc)) 1 0)
        )
             )
          )
          (while (< (setq stp (+ stp alen)) nxp)
            (setq
       pts (cons (vlax-curve-getPointAtDist objts stp) pts)
            )
          )
        )
      )
           )
           clr
           (if pts
      (progn
        (setq
          ent2d (entmakex
           (append
             (list (cons 0 "LWPOLYLINE")
            (cons 100 "AcDbEntity")
            (cons 100 "AcDbPolyline")
            (cons 90 (length pts))
            (cons 70 0)
             )
             (mapcar (function (lambda (p) (cons 10 p))) pts)
           )
         )
        )(entdel ent)
      )
           )
           (setq uFlag (vla-EndUndoMark doc))
         )
      )
      (*error* nil)
      (princ)
    )

  4. #4
    Super Member marko_ribar's Avatar
    Computer Details
    marko_ribar's Computer Details
    Operating System:
    Windows 7 Ultimate X64
    Computer:
    Intel quad core CPU 4x2.66GHz, 8GB RAM
    Motherboard:
    INTEL compatibile
    CPU:
    quad core 4x2.66GHz
    RAM:
    8GB
    Graphics:
    NVIDIA GeForce 6600 GT
    Primary Storage:
    250 GB
    Secondary Storage:
    500 GB
    Monitor:
    Samsung 17''
    Discipline
    Architectural
    marko_ribar's Discipline Details
    Occupation
    Architecture, project designer, project visualisation
    Discipline
    Architectural
    Details
    space design - modeling and animations
    Using
    AutoCAD 2014
    Join Date
    Feb 2010
    Location
    Belgrade, Serbia, Europe
    Posts
    640

    Default

    Try this - used ChNthDxf sub-function from HofCad long time ago...

    Code:
    (defun ChNthDxf (e n code value / ed newDxf i oldDxfv k)
    (setq ed (entget e))
    (setq newDxf '())
    (setq oldDxfv '())
    (setq i 0)
    (foreach v ed
    (if (= (car v) code)
    (progn
    (setq i (+ i 1))
    (if (= i n)
    (progn
    (if (= value nil)
    (setq oldDxfv (cons v oldDxfv))
    (progn
    (setq newDxf (cons (cons code value) newDxf))
    (setq oldDxfv (cons v oldDxfv))
    )
    )
    )
    (setq newDxf (cons v newDxf))
    )
    )
    (setq newDxf (cons v newDxf))
    )
    )
    (foreach v ed
    (if (= (car v) code)
    (progn
    (setq k (+ i 1))
    (if (= k n)
    (setq newDxf (cons (cons code value) newDxf))
    )
    )
    )
    )
    (if (not (assoc code ed))
    (setq newDxf (cons (cons code value) newDxf))
    )
    
    (entmod (reverse newDxf))
    (entupd e)
    )
    
    (defun c:plstreighten ( / pl vertn k )
      (setq pl (car (entsel "\nPick LWPOLYLINE with arcs you want to streighten")))
      (setq vertn (cdr (assoc 90 (entget pl))))
      (setq k -1)
      (repeat vertn
        (setq k (1+ k))
        (chnthdxf pl k 42 0.0)
      )
    (princ)
    )
    
    (defun c:plsegstreighten ( / entspl pl pt k ) (vl-load-com)
      (setq entspl (entsel "\nPick LWPOLYLINE segment with arc you want to streighten"))
      (setq pl (car entspl))
      (setq pt (cadr entspl))
      (setq k (+ (fix (vlax-curve-getparamatpoint pl (osnap pt "nea"))) 1))
      (chnthdxf pl k 42 0.0)
    (princ)
    )
    M.R.
    Last edited by marko_ribar; 26th Feb 2012 at 06:52 pm. Reason: added c:plsegstreighten

    Marko Ribar, d.i.a. (graduated engineer of architecture)
    M.R. on YouTube

  5. #5
    Forum Newbie
    Using
    Civil 3D 2012
    Join Date
    Feb 2012
    Posts
    2

    Default

    Thanks pBe - i was able to use your routine and get the results i needed.

  6. #6
    Forum Deity pBe's Avatar
    Computer Details
    pBe's Computer Details
    Operating System:
    Windows XP
    Discipline
    Construction
    pBe's Discipline Details
    Discipline
    Construction
    Details
    Camp Construction planning and details
    Using
    AutoCAD 2009
    Join Date
    Apr 2010
    Posts
    2,633

    Default

    Registered forum members do not see this ad.

    Quote Originally Posted by dunthy View Post
    Thanks pBe - i was able to use your routine and get the results i needed.
    Cool beans

    Cheers

Similar Threads

  1. Lisp routine for changing a polyline into arcs and straight lines
    By bsimpson in forum AutoLISP, Visual LISP & DCL
    Replies: 29
    Last Post: 18th Jul 2011, 01:43 pm
  2. project chainage of polyline on a straight line
    By motee-z in forum AutoLISP, Visual LISP & DCL
    Replies: 29
    Last Post: 8th Dec 2010, 01:29 pm
  3. how to convert 2d Polyline to 3d Polyline
    By srikanthkamuju in forum AutoCAD Beginners' Area
    Replies: 3
    Last Post: 2nd Apr 2010, 11:59 pm
  4. How do I convert lines/arcs to polyline
    By peterg in forum AutoCAD Beginners' Area
    Replies: 10
    Last Post: 27th Feb 2010, 10:53 pm
  5. Convert a bunch of lines into a polyline
    By CADken in forum AutoCAD General
    Replies: 2
    Last Post: 14th Jun 2006, 02:15 pm

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts