View Full Version : Converting Arcs and Lines Into All Line Segments
CADdancer
2006-12-22, 04:39 PM
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
2006-12-22, 07:39 PM
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.
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
2006-12-23, 03:12 PM
This function will do it for you quite well.
Peter
CADdancer
2006-12-27, 07:08 PM
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
2006-12-27, 08:24 PM
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
2006-12-27, 08:56 PM
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
2006-12-28, 01:04 PM
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
2006-12-28, 03:44 PM
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
2006-12-28, 04:49 PM
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.
peter
2006-12-29, 01:17 PM
Would you like to learn more about activeX commands?
If you are I am sure there are others that would like to learn them also.
I can start a thread on it if you are interested.
Peter
Lions60
2007-01-02, 03:31 PM
As a matter of fact I wouldn't mind learning more about Activex commands. Its always good to have different programming techniques in your arsenal.
Adesu
2007-01-03, 02:26 AM
Hi vferrara,
Test my code,maybe can help you.
; catl is stand for Convert Arc To Line
; Design by : Adesu <Ade Suharna>
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 27 September 2006
; Program no.: 0435/09/2006
; Edit by :
(defun c:catl (/ cnt ep lst opt sp spt ss sse ssl ssn ssp tspt vevo)
(vl-load-com)
(setq ss (car (entsel "\nSelect an arc")))
(setq vevo (vlax-ename->vla-object ss))
(setq sp (vlax-get vevo 'startpoint))
(setq ep (vlax-get vevo 'endpoint))
(setq opt (getreal "\nEnter number of segment <12>: "))
(if
(= opt nil)
(setq opt 12)
(setq opt (fix opt))
)
(command "_divide" ss opt "")
(setq ssp (ssget "x" '((0 . "point"))))
(setq ssl (sslength ssp))
(setq cnt 0)
(repeat
ssl
(setq ssn (ssname ssp cnt))
(setq sse (entget ssn))
(setq spt (cdr (assoc 10 sse)))
(setq tspt (append tspt (list spt)))
(command "_erase" ssn "")
(setq cnt (1+ cnt))
)
(command "_erase" ss "")
(setq lst (append (list ep) tspt (list sp)))
(command "_line")
(foreach x lst
(command x)
)
(command "" "" "")
(princ)
)
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
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.