AutoCAD Descomponer arco

#1
Hola a tod@s:

Tengo una cuestion que desconozco si existe en AutoCad

Puedo descomponer un arco en polilinea o lineas ???

¿Para que?
En muchas ocasiones la traduccion de arcos entre sistemas distintos de CAD generan errores (los puntos extremos del arco no se tocan y antes si, los arcos aparecen pero desarrollados al reves, etc,etc) por ello a veces es frecuente o util el descomponerlos y sustituirlos por una polilinea aproximada cuya traduccion o trasvase a otro sistema es mas fiable.

¿Existe esa orden en AutoCAD?

Gracias de antemano
 
#2
Con la orden _Break puedes romper un arco tantas veces como quieras en trozitos de arco mas pequeños. Siempre son arcos.

Otra opcion es generar una polilinea envolvente...

Saludos.
 
#3
No se si existira, yo l que haria es dividir el arco en tantos trozos como precison quiera dar, y unir los puntos finales de los trozos con una polilinea... no paraece que sea mucho trabajo
 
#4
GRACIAS

Gracias por las respuestas pero no es exactamente lo que busco.
Dividir via break me da que lo que hace es magnificar el problema, de un solo arco obtener mas pues creo q no, se agradece de todas formas.

Y la segunda opcion (divide y venceras) pues tambien, pero cuando te encuentras con muchos arcos a descomponer la tarea se hace tambien enorme.

Yo desarrolle algo para Micrstation que lo hacia, pero hace muucchhoooo tiempo y pensaba que podia ser alguna mejora de los nuevos autocases ;)

Bueno, fumando espero..... (bueno, hasta el 1 de enero :D :D )
 
#5
Hola theranner, tengo un lisp que hace lo que necesitas pero solo me funciona con elipse, si sabes de lisp, te le hago llegar y si nó, creo que puedo ponerte en contacto con la persona que le hizo y posiblemente pueda modificarle para lo que necesitas.
 
#6
Gracias por el ofrecimiento pero por ahora lo he solucionado poligonos regulares con muchos lados y capturando el centro de los arcos, luego recortas y ya esta.

Vamos era un tema puntual para el que desconocia si existia una orden especifica!!

Gracias de todos modos!!

De mi epoca de informatico.... sabeis por que se llama AutoLisp??:cool:

Auto de autocad :rolleyes:
LISP del lenguaje de programacion basado en
List of Insipid and Stupid Parenthesis :D
 
#7
Hola theranner

Para otra vez puedes usar esto.

Código:
(mapcar ;
 '(lambda (x) (princ (strcat "\n" x)))
 (list
 "*************************************************************************"
 "-- Orden CurveToPol"
 "Convierte una curva en una polilínea 2D/3D/LW"
 "Versión:"
 " 1.0 (18/09/2005)"
 "Notas:"
 " - No se conservan los posibles vértices intermedios de la curva origen."
 " - La polilínea resultante está formada sólo por tramos rectos."
 " - La polilínea 2D/LW resultante toma su elevación de la del punto"
 " de inicio de la curva origen."
 "*************************************************************************"
 "Nuevo comando CurveToPol (C2P) definido en AutoCAD - ©2005 scaner, Spain."
 )
)
 ;
(vl-load-com)
 ;
(defun c:C2P () (c:CurveToPol))
 ;
(defun c:CurveToPol (/ acadDoc Space entorno lstNameObj
 isObj? Crv nSeg tyPol Tucs
;;; -- Funciones locales --
 *error* #error# dxf
 )
;;; ---------------------------------
;;; Variables globales y de entorno
;;; ---------------------------------
 (or *crv2Pol:global*
 (setq *crv2Pol:nSeg* 100
 *crv2Pol:type* "L"
 *crv2Pol:global* T
 )
 )
 (setq acadDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (if (or :) (vla-get-Name (vla-get-ActiveLayout acadDoc)) "Model")
 :) (vla-get-MSpace acadDoc) :vlax-true)
 )
 (setq Space (vla-get-ModelSpace acadDoc))
 (setq Space (vla-get-PaperSpace acadDoc))
 )
 (setq entorno (mapcar (function (lambda (x) (list (car x) (cadr x) (getvar (car x)))))
 '(("cmdecho" 0) ;
 ("ucsicon" 0)
 ("ucsfollow" 0)
 ("osnapcoord" 1)
 )
 )
 lstNameObj '(ENA "ARC" "CIRCLE" "ELLIPSE" "LWPOLYLINE" "POLYLINE" "SPLINE")
 )
;;; -----------------------------------------
;;; cdr de un elemento asociado a una llave
;;; -----------------------------------------
 (defun dxf (Ass Ena) (cdr (assoc Ass (entget Ena))))
;;; ------------------------
;;; Tratamiento de errores
;;; ------------------------
 (defun #error# (msg)
 (princ msg)
 (while (/= (getvar "cmdnames") "") (command))
 (vla-EndUndoMark acadDoc)
 (vl-cmdf "_.undo" "1")
 (prompt " ¡Se ha restituido el dibujo a su estado anterior! ")
 )
;;; ---------------
;;; Toma de datos
;;; ---------------
 (while (not isObj?)
 (setq Crv
 (car
 (entsel
 "\nDesigne una curva (Arco, Círculo, Elipse, LWPolilínea, Polilínea 2D/3D, o Spline): "
 )
 )
 )
 (checking-objects Crv lstNameObj nil)
 )
 (if Crv
 (progn
 (while isObj?
 (initget ( 2 4))
 (if (setq nSeg
 (getint
 (strcat "\nPrecise número de segmentos <" (itoa *crv2Pol:nSeg*) ">: ")
 )
 )
 (if (and (vlax-curve-isClosed Crv) :) nSeg 1))
 (prompt "\nLa curva es cerrada. ¡El número de segmentos debe ser mayor de 1!")
 (setq isObj? nil
 *crv2Pol:nSeg* nSeg
 )
 )
 (setq isObj? nil
 nSeg *crv2Pol:nSeg*
 )
 )
 )
 (initget "L 2 3")
 (if (setq
 tyPol (getkword (strcat "\nPrecise tipo de polilínea [Lwpol, 2dpol, 3dpol] <"
 *crv2Pol:type*
 ">: "
 )
 )
 )
 (setq *crv2Pol:type* tyPol)
 (setq tyPol *crv2Pol:type*)
 )
 )
 )
;;; -----------
;;; Principal
;;; -----------
 (if Crv
 (progn (setq *error* #error#)
 (vla-StartUndoMark acadDoc)
 (mapcar (function (lambda (x) (setvar (car x) (cadr x)))) entorno)
 (if :) (getvar "worlducs") 0)
 (progn (vl-cmdf "_.ucs" "_delete" (setq Tucs "CurveToPol_Tucs"))
 (vl-cmdf "_.ucs" "_save" Tucs)
 (vl-cmdf "_.ucs" "_world")
 )
 )
 (CurveToPol Crv nSeg tyPol)
 (if Tucs
 (progn (vl-cmdf "_.ucs" "_restore" Tucs) (vl-cmdf "_.ucs" "_delete" Tucs))
 )
 (mapcar (function (lambda (x) (setvar (car x) (caddr x)))) entorno)
 (vla-EndUndoMark acadDoc)
 )
 )
 (princ)
)
;;; -------------------
;;; Función principal 
;;; -------------------
(defun CurveToPol (Crv nSeg tyPol / lstPnt lstArr Arr Elev Pol)
 (setq lstPnt (ax-divide-curve Crv nSeg nil)
 lstArr (apply 'append
 (if :) tyPol "L")
 (flatten-xy lstPnt)
 lstPnt
 )
 )
 Arr (vlax-make-variant
 (vlax-safearray-fill
 (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length lstArr))))
 lstArr
 )
 )
 Pol (cond (:) tyPol "L") (vla-AddLightweightPolyline Space Arr))
 (:) tyPol "2") (vla-AddPolyline Space Arr))
 (:) tyPol "3") (vla-Add3DPoly Space Arr))
 )
 Crv (vlax-ename->vla-object Crv)
 )
 (ax-put-properties
 Pol
 (append
 (list (cons 'Closed
 (if (vlax-curve-isClosed Crv)
 :vlax-true
 :vlax-false
 )
 )
 (cons 'Elevation (vlax-make-variant (last (vlax-curve-getStartPoint Crv))))
 )
 (ax-get-properties
 Crv
 '(ConstantWidth Layer Linetype LinetypeGeneration LinetypeScale TrueColor Type)
 )
 )
 )
 (vla-Delete Crv)
)
;;; -------------------------
;;; Comprobación de objetos
;;; -------------------------
(defun checking-objects (Obj lstNameObj lstEqObj / typ lstName)
 (setq typ (car lstNameObj)
 lstNameObj (cdr lstNameObj)
 lstName (list ;
 ;
 ; -----------------------
 ; Entities AutoCAD 2005
 ; -----------------------
 ;
 ; AcDbEntity
 ;
 ; - Basics -
 ;
 ; AcDbBlockReference
 '("INSERT" "Bloque") ;
 '("AcDbBlockReference" "Bloque") ;
 '("AcDbMInsertBlock" "Inserción matricial") ;
 '("TABLE" "Tabla") ;
 '("AcDbTable" "Tabla") ;
 ; AcDbFace 
 '("3DFACE" "Cara 3D") ;
 '("AcDbFace" "Cara 3D") ;
 ; AcDbFcf
 '("TOLERANCE" "Tolerancia") ;
 '("AcDbFcf" "Tolerancia") ;
 ; AcDbOleFrame
 '("AcDbOleFrame" "OleFrame") ;
 '("AcDbOle2Frame" "Ole2Frame") ;
 ; AcDbHatch
 '("HATCH" "Sombreado") ;
 '("AcDbHatch" "Sombreado") ;
 ; AcDbImage
 '("IMAGE" "Imagen") ;
 '("AcDbRasterImage" "Imagen") ;
 '("WIPEOUT" "Cobertura") ;
 '("AcDbWipeout" "Cobertura") ;
 ; AcDbMline
 '("MLINE" "LíneaM") ;
 '("AcDbMline" "Línea múltiple") ;
 ; AcDbMText
 '("MTEXT" "TextoM") ;
 '("AcDbMText" "Texto múltiple") ;
 ; AcDbSolid
 '("SOLID" "Sólido") ;
 '("AcDbSolid" "Sólido") ;
 ; AcDbTrace
 '("TRACE" "Trazo") ;
 '("AcDbTrace" "Trazo") ;
 ; AcDbViewport
 '("VIEWPORT" "Ventana gráfica") ;
 '("AcDbViewport" "Ventana gráfica") ;
 ; AcDbMPolygon 
 '("MPOLYGON" "PolígonoM") ;
 '("AcDbMPolygon" "PolígonoM") ;
 ; AcDbPoint
 '("POINT" "Punto") ;
 '("AcDbPoint" "Punto") ;
 ; AcDbPolyFaceMesh
 '("AcDbPolyFaceMesh" "Malla policara") ;
 ; AcDbPolygonMesh
 '("AcDbPolygonMesh" "Malla poligonal") ;
 ; AcDbProxyEntity
 '("AcDbProxyEntity" "Entidad proxy") ;
 ; AcDbShape
 '("SHAPE" "Forma") ;
 '("AcDbShape" "Forma") ;
 ; AcDbText
 '("TEXT" "Texto") ;
 '("AcDbText" "Texto") ;
 '("ATTRIB" "Atributo") ;
 '("AcDbAttribute" "Atributo") ;
 '("ATTDEF" "Definición de Atributo") ;
 '("AcDbAttributeDefinition" "Definición de Atributo") ;
 ;
 ; - Curves -
 ;
 ; AcDbCurve
 '("POLYLINE" "Polílinea 2D/3D") ;
 '("AcDb2dPolyline" "Polílinea 2D") ;
 '("AcDb3dPolyline" "Polílinea 3D") ;
 '("ARC" "Arco") ;
 '("AcDbArc" "Arco") ;
 '("CIRCLE" "Círculo") ;
 '("AcDbCircle" "Círculo") ;
 '("ELLIPSE" "Elipse") ;
 '("AcDbEllipse" "Elipse") ;
 '("LEADER" "Directriz") ;
 '("AcDbLeader" "Directriz") ;
 '("LINE" "Línea") ;
 '("AcDbLine" "Línea") ;
 '("LWPOLYLINE" "LWPolilínea") ;
 '("AcDbPolyline" "LWPolilínea") ;
 '("RAY" "Rayo") ; 
 '("AcDbRay" "Rayo") ;
 '("SPLINE" "Spline") ;
 '("AcDbSpline" "Spline") ;
 '("XLINE" "Línea auxiliar") ;
 '("AcDbXline" "Línea auxiliar") ;
 ;
 ; - Dimensions -
 ;
 ; AcDbDimension
 '("DIMENSION" "Cota") ;
 '("AcDb2LineAngularDimension" "Cota angular") ;
 '("AcDbAlignedDimension" "Cota alineada") ;
 '("AcDbDiametricDimension" "Cota de diámetro") ;
 '("AcDbOrdinateDimension" "Cota de coordenadas") ;
 '("AcDb3PointAngularDimension" "Cota angular por 3 puntos") ;
 '("AcDbRadialDimension" "Cota de radio") ;
 '("AcDbRotatedDimension" "Cota lineal") ;
 ;
 ; - 2D/3D Modeling -
 ;
 '("3DSOLID" "Sólido 3D") ; 
 '("AcDb3dSolid" "Sólido 3D") ;
 '("BODY" "Cuerpo 3D") ;
 '("AcDbBody" "Cuerpo 3D") ;
 '("REGION" "Región") ;
 '("AcDbRegion" "Región") ;
 ;
 ; - Vertex Subentities -
 ;
 ; AcDbVertex
 '("VERTEX" "Vértice") ;
 '("AcDb2dVertex" "Vértice polílinea 2D") ;
 '("AcDb3dPolylineVertex" "Vértice polílinea 3D") ;
 '("AcDbPolyFaceMeshVertex" "Vértice malla policara") ;
 '("AcDbFaceRecord" "Cara malla policara") ;
 '("AcDbPolygonMeshVertex" "Vértice malla poligonal") ;
 )
 )
 (cond
 (:) (getvar "errno") 52)
 (prompt "\nOrden finalizada por el usuario.")
 (setvar "errno" 0)
 (setq isObj? T)
 )
 ((not Obj) (prompt "\nNo ha designado nada ..."))
 ((apply 'or (mapcar (function (lambda (x) (eq Obj x))) lstEqObj))
 (prompt "\n¡Objeto No Válido! Designación repetida.")
 )
 ((or (and :) typ 'ENA) (not (member (cdr (assoc 0 (entget Obj))) lstNameObj)))
 (and :) typ 'VLA)
 (not (member (vlax-get-property (vlax-ename->vla-object Obj) 'ObjectName)
 lstNameObj
 )
 )
 )
 )
 (prompt
 (strcat
 "\n¡Objeto No Válido! \nDebe ser"
 (apply
 'strcat
 (mapcar
 (function
 (lambda (x)
 (strcat
 (if (> ( 2 (vl-position x lstNameObj)) (vl-list-length lstNameObj) 1)
 " o "
 " "
 )
 (cadr (assoc x lstName))
 (if (< ( 2 (vl-position x lstNameObj)) (vl-list-length lstNameObj))
 ","
 ""
 )
 )
 )
 )
 lstNameObj
 )
 )
 "."
 )
 )
 )
 (T (setq isObj? T))
 )
 (princ)
)
 ;
 ; -- Función ax-divide-curve
 ; Divide una curva en un número de partes iguales.
 ; Copyright:
 ; .../...
 ; Argumentos [Type]:
 ; Obj = Entity name / ActiveX object [ENAME / VLA-OBJECT] 
 ; nDiv = Número de divisiones [INT]
 ; End = Modificador (sin función para curvas abiertas) [SYM]
 ; T = Se incluye el punto final.
 ; nil = No se incluye el punto final.
 ; Retorna [Type]:
 ; > Lista de puntos 3D '((1.0 1.0 1.0)...) 
[LIST]
 ; Notas:
 ; En curvas cerradas el punto inicial y el final son el mismo.
 ; Para las curvas cerradas se incluye el punto final, según modificador.
 ;
(defun ax-divide-curve (Obj nSeg End / Dis Dis lst)
 (setq Dis (/ (vlax-curve-getDistAtParam Obj (vlax-curve-getEndParam Obj)) nSeg)
 Dis Dis
 lst (cons (vlax-curve-getStartPoint Obj) lst)
 )
 (repeat (1- nSeg)
 (setq lst (cons (vlax-curve-getPointAtParam Obj (vlax-curve-getParamAtDist Obj Dis )) lst)
 Dis ( Dis Dis)
 )
 )
 (if (and (vlax-curve-isClosed Obj) (not End))
 (reverse lst)
 (reverse (cons (vlax-curve-getEndPoint Obj) lst))
 )
)
 ;
 ; -- Función flatten-xy
 ; Transforma coordenadas 3d en coordenadas 2d.
 ; Copyright:
 ; .../...
 ; Argumentos [Type]:
 ; Lst = Lista de puntos 3D '((1.0 1.0 1.0)...) 
[LIST] 
 ; Retorna [Type]:
 ; > Lista de puntos 2D '((1.0 1.0)...) 
[LIST]
 ; Notas:
 ; Ninguna
 ;
(defun flatten-xy (lst) (mapcar 'list (mapcar 'car lst) (mapcar 'cadr lst)))
 ;
 ; -- Función ax-get-properties
 ; Recupera los valores de las propiedades especificadas de un objeto.
 ; Copyright:
 ; ... / ...
 ; Argumentos [Type]:
 ; Obj = ActiveX object [VLA-object]
 ; lst = Lista de propiedades 
[LIST]
 ; Retorna [Type]:
 ; lst = Lista de pares punteados '(("Pro1" . "Val1")...) 
[LIST]
 ; car -> Propiedad (símbolo) [SYM]
 ; cdr -> Valor de la propiedad [REAL/INT/STR]
 ; Notas:
 ; Comprueba si las propiedades están disponibles para el objeto.
 ;
(defun ax-get-properties (Obj lst / lstPro)
 (foreach x lst
 (if (vlax-property-available-p Obj x)
 (setq lstPro (cons (cons x (vlax-get-property Obj x)) lstPro))
 )
 )
 (reverse lstPro)
)
 ;
 ; -- Función ax-put-properties
 ; Fija las propiedades de un objeto a los valores especificados.
 ; Copyright:
 ; ... / ...
 ; Argumentos [Type]:
 ; Obj = ActiveX object [VLA-object]
 ; lst = Lista de pares punteados '(("Pro1" . "Val1")...) 
[LIST]
 ; car -> Propiedad (símbolo) [SYM]
 ; cdr -> Valor de la propiedad [REAL/INT/STR]
 ; Retorna [Type]:
 ; Nada
 ; Notas:
 ; Comprueba si las propiedades están disponibles para el objeto y son modificables.
 ;
(defun ax-put-properties (Obj lst)
 (foreach x lst
 (if (vlax-property-available-p Obj (car x) T)
 (vlax-put-property Obj (car x) (cdr x))
 )
 )
 (princ)
)
(princ)
Un saludo
Scaner
 
Arriba