Converting Arcs and Lines Into All Line Segments

[CADdancer]

Happy Holidays to All AUGI Members:

Is it possible, with a lisp routine to convert all intersecting line and arcs (circles) into all straight line segments....??....I have attached an example drawing showing what I might start with and what I want to finish with.

Any help in resolving this problem would be appreciated.

Regards,
Vince

[DarrenYoung]

Possible, yes. Just how easily is another issue all togeter. All depends on the prompts and input you are willing to give at and how predictable the geometry is. Are the arcs always offset the same number of times? Are the always offset the same distance? Are the division lines always equally spaced? etc. etc.

[fixo]

Hi,
this is very quick and dirty routine almost not tested
but seems to be work on the first glance
Select both lines and arcs by window or by other method
Let me know when you will be found something wrong there

(defun C:ALE (/	*error*	acsp adoc arc arc_list i lay line line_list ss
	      tmp)
  (if (< (atoi (substr (getvar "acadver") 1 2)) 15)
    (progn
      (alert
	"Program will be works starting\n
               from A2000 and higher ..."
      )
      (exit)
      (princ)
    )
  )
  (or (vl-load-com))

  (defun *error* (msg)
    (princ msg)
    (vla-endundomark
      (vla-get-activedocument
	(vlax-get-acad-object)
      )
    )
    (princ)
  )
  (or adoc
      (setq adoc (vla-get-activedocument
		   (vlax-get-acad-object)
		 )
      )
  )
  (or acsp
      (setq acsp (if (= (getvar "CVPORT") 1)
		   (vla-get-paperspace
		     adoc
		   )
		   (vla-get-modelspace
		     adoc
		   )
		 )
      )
  )

  (vla-endundomark
    adoc
  )
  (vla-startundomark
    adoc
  )

  (setq ss (ssget (list (cons 0 "LINE,ARC"))))
  (setq i 0)
  (vlax-for a (vla-get-activeselectionset adoc)
    (if	(eq "AcDbLine" (vla-get-objectname a))
      (setq line_list (cons a line_list))
      (setq arc_list (cons a arc_list))
    )
  )
  (setq lay (vla-get-layer (car arc_list)))

  (foreach arc arc_list
    (setq tmp
	   (vl-remove-if
	     (function not)
	     (mapcar
	       (function
		 (lambda (x)
		   (vlax-invoke arc 'Intersectwith x acextendnone)
		 )
	       )
	       line_list
	     )
	   )
    )
    (setq tmp
	   (vl-sort tmp
		    (function (lambda (p q)
				(<= (vlax-curve-getparamatpoint
				      arc
				      (vlax-curve-getclosestpointto arc p)
				    )
				    (vlax-curve-getparamatpoint
				      arc
				      (vlax-curve-getclosestpointto arc q)
				    )
				)
			      )
		    )
	   )
    )
    (mapcar (function (lambda (m n)
			(progn
			  (setq line (vlax-invoke acsp 'Addline m n))
			  (vla-put-layer line lay)
			)
		      )
	    )
	    tmp
	    (cdr tmp)
    )
  )
  (foreach arc arc_list
    (vla-delete arc)
  )
  (*error* nil)
  (princ)
)
(prompt "\n\t\t***\tType ALE to execute...\t***\n")
(princ)

~'J'~

[peter]

This function will do it for you quite well.

Peter

[CADdancer]

Hi Peter:

Thank you for responding to my post....!

Your ArcToSeg.lsp routine worked great. It did everything I needed the program to accomplish and did so very quickly however, I do have one question. How difficult would it be to convert the Arc segments into Line segments instead of Polyline segments....??

Once again thank you for your expert solution to my problem....!

Regards,
Vince

[Lions60]

This should do what you want. Hope you don't mind me modifying your code peter. The only thing i did was add (setq ent (entlast)) (command "explode" ent"") after (vla-delete objarc)

(defun C:ArcToSeg (/ lstCoordinates 
                     lstOfParams 
                     lstOfPoints 
                     lstPoint 
                     objArc 
                     objLine 
                     sngEndParam 
                     ssSSArcs 
                     ssSSLines )
 (princ "\nSelect arcs to convert: ")
 (setq ssSSArcs  (ssget (list (cons 0 "arc")))
       ssSSLines (ssget "x" (list (cons 0 "line")))
 )
 (repeat (setq intCountArc (sslength ssSSArcs))
  (setq intCountArc (1- intCountArc)
        objArc      (vlax-ename->vla-object (ssname ssSSArcs intCountArc))
  )
  (repeat (setq intCountLine (sslength ssSSLines))
   (setq intCountLine (1- intCountLine)
         objLine      (vlax-ename->vla-object (ssname ssSSLines intCountLine))
   )
   (if (setq lstPoint (vlax-invoke objArc "intersectwith" objLine acExtendNone))
    (if lstOfParams
     (setq lstOfParams (append lstOfParams
                               (list (vlax-curve-getparamatpoint objArc lstPoint))))
     (setq lstOfParams (list (vlax-curve-getparamatpoint objArc lstPoint)))
    )
   )
  )
  (if (not (member 0.0 lstOfParams))
   (setq lstOfParams (append (list 0.0) lstOfParams)))

  (if (not (member (setq sngEndParam (vlax-curve-getendparam objArc)) lstOfParams))
   (setq lstOfParams (append lstOfParams (list sngEndParam))))

  (setq lstOfParams (vl-sort lstOfParams '<)
        lstOfPoints (mapcar '(lambda (X) (vlax-curve-getpointatparam objArc X))
                            lstOfParams
                    ) 
  )
  (foreach lstPoint lstOfPoints
   (if lstCoordinates 
    (setq lstCoordinates (append lstCoordinates lstPoint))
    (setq lstCoordinates lstPoint) 
   )
  )
  (print lstCoordinates)
  (setq objPolyline (vla-AddMLine 
                     (vla-get-block 
                      (vla-get-activelayout 
                       (vla-get-activedocument 
                        (vlax-get-acad-object))))   
                     (listtovariantsafearray 5 lstCoordinates)
                    )
  )
  (vla-put-layer     objPolyline (vla-get-layer     objArc))
  (vla-put-truecolor objPolyline (vla-get-truecolor objArc))
  (vla-put-linetype  objPolyline (vla-get-linetype  objArc))
  (vla-delete objArc)
   (setq ent (entlast))
   (command "explode" ent"")
  (setq lstOfParams      nil
        lstOfPoints      nil
        lstCoordinates nil
  )
 )
)



; This function creates a variant safearray from a list and the safearray type symbol
; for example: (listtovariantsafearray vlax-vbinteger (list 0) )
; Written By: Peter Jamtgaard

(defun ListToVariantSafeArray (symSafeArrayType lstItems / safArray)
 (setq safArray (vlax-make-safearray symSafeArrayType (cons 0 (1- (length lstItems)))))
 (vlax-safearray-fill safArray lstItems)
 (variant safArray))

;vlax-vbInteger  (2)  Integer 
;vlax-vbLong     (3)  Long integer 
;vlax-vbSingle   (4)  Single-precision floating-point number 
;vlax-vbDouble   (5)  Double-precision floating-point number 
;vlax-vbString   (8)  String 
;vlax-vbObject   (9)  Object 
;vlax-vbBoolean (11)  Boolean 
;vlax-vbVariant (12)  Variant

[CADdancer]

Hi Lions60:

When I incorporate your (2) lines of code into Peter's routine it not only explodes the polyline segments into lines but at all of the intersections of the original lines and arcs there is a line segment with a length of 0. Can anyone explain why this occurs....??

Regards,
Vince

[Lions60]

I just ran the code again and on the arcs that were converted i was getting double lines. This was because i forgot to change the code back to draw polylines. As for the 0 length lines i did not have this problem.

Updated to draw polylines instead of MLines. Hopefully this will solve the problem.

(defun C:ArcToSeg (/ lstCoordinates 
                     lstOfParams 
                     lstOfPoints 
                     lstPoint 
                     objArc 
                     objLine 
                     sngEndParam 
                     ssSSArcs 
                     ssSSLines )
 (princ "\nSelect arcs to convert: ")
 (setq ssSSArcs  (ssget (list (cons 0 "arc")))
       ssSSLines (ssget "x" (list (cons 0 "line")))
 )
 (repeat (setq intCountArc (sslength ssSSArcs))
  (setq intCountArc (1- intCountArc)
        objArc      (vlax-ename->vla-object (ssname ssSSArcs intCountArc))
  )
  (repeat (setq intCountLine (sslength ssSSLines))
   (setq intCountLine (1- intCountLine)
         objLine      (vlax-ename->vla-object (ssname ssSSLines intCountLine))
   )
   (if (setq lstPoint (vlax-invoke objArc "intersectwith" objLine acExtendNone))
    (if lstOfParams
     (setq lstOfParams (append lstOfParams
                               (list (vlax-curve-getparamatpoint objArc lstPoint))))
     (setq lstOfParams (list (vlax-curve-getparamatpoint objArc lstPoint)))
    )
   )
  )
  (if (not (member 0.0 lstOfParams))
   (setq lstOfParams (append (list 0.0) lstOfParams)))

  (if (not (member (setq sngEndParam (vlax-curve-getendparam objArc)) lstOfParams))
   (setq lstOfParams (append lstOfParams (list sngEndParam))))

  (setq lstOfParams (vl-sort lstOfParams '<)
        lstOfPoints (mapcar '(lambda (X) (vlax-curve-getpointatparam objArc X))
                            lstOfParams
                    ) 
  )
  (foreach lstPoint lstOfPoints
   (if lstCoordinates 
    (setq lstCoordinates (append lstCoordinates lstPoint))
    (setq lstCoordinates lstPoint) 
   )
  )
  (print lstCoordinates)
  (setq objPolyline (vla-AddpolyLine 
                     (vla-get-block 
                      (vla-get-activelayout 
                       (vla-get-activedocument 
                        (vlax-get-acad-object))))   
                     (listtovariantsafearray 5 lstCoordinates)
                    )
  )
  (vla-put-layer     objPolyline (vla-get-layer     objArc))
  (vla-put-truecolor objPolyline (vla-get-truecolor objArc))
  (vla-put-linetype  objPolyline (vla-get-linetype  objArc))
  (vla-delete objArc)
   (setq ent (entlast))
   (command "explode" ent"")
  (setq lstOfParams      nil
        lstOfPoints      nil
        lstCoordinates nil
  )
 )
)



; This function creates a variant safearray from a list and the safearray type symbol
; for example: (listtovariantsafearray vlax-vbinteger (list 0) )
; Written By: Peter Jamtgaard

(defun ListToVariantSafeArray (symSafeArrayType lstItems / safArray)
 (setq safArray (vlax-make-safearray symSafeArrayType (cons 0 (1- (length lstItems)))))
 (vlax-safearray-fill safArray lstItems)
 (variant safArray))

;vlax-vbInteger  (2)  Integer 
;vlax-vbLong     (3)  Long integer 
;vlax-vbSingle   (4)  Single-precision floating-point number 
;vlax-vbDouble   (5)  Double-precision floating-point number 
;vlax-vbString   (8)  String 
;vlax-vbObject   (9)  Object 
;vlax-vbBoolean (11)  Boolean 
;vlax-vbVariant (12)  Variant

[peter]

I didn't have the problem with the 0 length lines but for making line segments instead of polyline a properly placed

(vla-explode objPolyline)

statement in the arctoseg.lsp code will explode the polylines.

I personally always work with polylines rather than lines.
Just my preference.

Here is the revised code.

Peter

[Lions60]

As you can probably tell i have never worked with the activex commands at all. I'm glad peter came back and revised his code with the activex commands to keep consistency.