Hola a todos me podriais ayudar con un lisp que detectara la interseccion de unas lineas con una polilinea?
3 participantes
Página 1 de 1.
Hola a todos me podriais ayudar con un lisp que detectara la interseccion de unas lineas con una polilinea?
Buenas Tardes a todos y gracias por vuestra colaboración.
Hace años (en el 2009) logré escribir con mucho esfuerzo (cogiendo cachitos de rutinas que iba encontrando y mezclandolas...) una rutina de Autolisp para que a partir de una polilinea , me creara un solido, me calculara el CDG y me dibujara en autocad dos lineas paralelas (con una longitud de linea fija) a equis distancia de el Centro de Gravedad.
Ahora con el parón forzoso por el COVID-19, quería modificar esa rutina para que las lineas paralelas, solo las dibuje hasta la intersección con la polilinea y no sobrepasen la polilinea(marcado con un circulo en el dibujo).
Pero tengo este tema de la programación muy dejado y no se muy bien como hacerlo.
Adjunto un dibujo aclaratorio:
Si necesitáis la rutina original, me lo decís y la adjunto.
Muy agradecido si me podéis echar una mano.
Hace años (en el 2009) logré escribir con mucho esfuerzo (cogiendo cachitos de rutinas que iba encontrando y mezclandolas...) una rutina de Autolisp para que a partir de una polilinea , me creara un solido, me calculara el CDG y me dibujara en autocad dos lineas paralelas (con una longitud de linea fija) a equis distancia de el Centro de Gravedad.
Ahora con el parón forzoso por el COVID-19, quería modificar esa rutina para que las lineas paralelas, solo las dibuje hasta la intersección con la polilinea y no sobrepasen la polilinea(marcado con un circulo en el dibujo).
Pero tengo este tema de la programación muy dejado y no se muy bien como hacerlo.
Adjunto un dibujo aclaratorio:
Si necesitáis la rutina original, me lo decís y la adjunto.
Muy agradecido si me podéis echar una mano.
aserponcet- Mensajes : 1
Fecha de inscripción : 18/03/2020
Interseccion
Amigo Fíjate si te Sirve el Siguiente Lisp
Un Saludo
Luis
- Código:
(vl-load-com)
;;-----------------------------------------------
;; CDNC5-02.LSP
;; Bill Kramer
;; (modificaciones y mejoras de CAD de estudio, www.cadstudio.cz, 2010-2014)
;;
;; ILSIMPLEMODE = T para intersección única sólo (gran problema coord)
;;
;; Encuentra todas las intersecciones entre objetos en
;; el conjunto de selección SS.
;;
;; ---------------------------------------------- EMPEZAR LA LISTA 1
;;
(defun get_all_inters_in_SS (SS /
SSL ;length of SS
PTS ;returning list
aObj1 ;Object 1
aObj2 ;Object 2
N1 ;Loop counter
N2 ;Loop counter
iPts ;intersects
C1 C2 C3
)
(setvar "cmdecho" 0)
(vl-cmdf "_UCS""u")
(defun iL->L (iPts / Pts) ; convert coordlist -> pointlist
(while (> (length iPts) 0)
(setq Pts (cons (list (car iPts)
(cadr iPts)
(caddr iPts))
Pts)
iPts (cdddr iPts)))
Pts
)
(defun iL2->L (iPts / Pts) ; convertir coordlist -> 2D pointlist
(while (> (length iPts) 0)
(setq Pts (cons (list (car iPts)
(cadr iPts)
'0.0)
Pts)
iPts (cddr iPts)))
Pts
)
(defun DelDup ( l / x r ) ; eliminar duplicados
(while l
(setq x (car l)
l (vl-remove x (cdr l))
r (cons x r)
)
)
(reverse r)
)
(setq N1 0 ;índice de bucle externo
SSL (sslength SS))
; Lazo externo, primero a través de la penúltima
(while (< N1 (1- SSL)) ; nebo <= ?
; Obtén objeto 1, convertir a VLA tipo de objeto
(setq aObj1 (ssname SS N1)
aObj1 (vlax-ename->vla-object aObj1)
N2 (1+ N1)) ;index for inner loop
; auto-intersecciones:
(if (vlax-property-available-p aObj1 'Coordinates)(progn ;es una curva? LWPOLY
(setq C1 (iL2->L (vlax-get aObj1 'Coordinates)))
(setq C2 (iL->L (vlax-invoke aObj1 'IntersectWith aObj1 0)))
(setq C3 (vl-remove-if '(lambda ( x ) (member x C1)) C2))
; (PRINT C1)(PRINT C2)(PRINT C3)
(if C3 (foreach x C3 (setq Pts (cons x Pts)))) ; add selfs
))
(if (= (vlax-get aObj1 'ObjectName) "AcDbSpline")(progn ; SPLINE
(setq C1 (iL->L (vlax-invoke aObj1 'IntersectWith aObj1 0)))
; (PRINT C1)
(if C1 (foreach x C1 (setq Pts (cons x Pts)))) ; add selfs
))
; Lazo interno, ir through Objetos Que Quedan
(while (< N2 SSL) ; bucle innser
; Obtén objeto 2, convertir a objeto VLA
(setq aObj2 (ssname SS N2)
aObj2 (vlax-ename->vla-object aObj2)
; Encuentra intersecciones de objetos
iPts (vla-intersectwith aObj1
aObj2 0)
; resultado variante
iPts (vlax-variant-value iPts))
; Matriz Variant tiene valores?
(if (> (vlax-safearray-get-u-bound iPts 1)
0)
(progn ; matriz contiene valores, convertirlido
(setq iPts ; a una lista.
(vlax-safearray->list iPts))
; Recorrer Lista Construir Puntos
; (setq Pts (iL->L iPts)) ; debe ser global
;(if (> (length iPts) 3)(PRINT iPts)) --- LIST DUPLICATE INTERSECTIONS - THE RED/GREEN CASE GIVES TWO INTERSECTIONS !
(while (> (length iPts) 0)
(setq Pts (cons (list (car iPts)
(cadr iPts)
(caddr iPts))
Pts)
iPts (cdddr iPts))
(if ILSIMPLEMODE (setq iPts nil)) ; ILSIMPLEMODE - tome solamente la primera intersección
)
))
(setq N2 (1+ N2))) ; final del bucle interno
(setq N1 (1+ N1))) ; final del bucle externo
Pts) ; lista de regreso de los puntos encontrados
;;----------------------------------------------- FIN LISTADO 1
;;
;; Resto de líneas de código para la versión de descarga, que se utiliza para demostrar y probar la utilidad en el Listado 1.
;;
;; Proceso - Crear dibujo con líneas de intersección y lwpolylines.
;; Conjunto de funciones de carga
;; Ejecutar INTLINES función de comando
;; Intersecciones están marcados con objetos de punto en la capa actual
;;
(defun C:INTLINES ( / SS1 PT ptl oldos)
(prompt "\nINTLINES corriendo para demostrar la función GET_ALL_INTERS_IN_SS")
(PRINC "\nSeleccionar los Objetos de Intersección:")
(setq SS1 (ssget);(ssget "_X");(get_all_lines_as_SS)
PTS (get_all_inters_in_ss SS1)
)
(setq ptl (length PTS) PTS (deldup PTS)) ; duplicados - no deben ser cualquier
(if (> ptl (length PTS)) (princ (strcat "\n" (itoa (- (length PTS) ptl)) " duplicates removed")))
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
(setvar "CMDECHO" 0)
(setq oldos (getvar "OSMODE"))(setvar "OSMODE" 0)
(foreach PT PTS ;; Recorrer lista de puntos
(command "_POINT" PT)) ;; Crear punto objeto (también puede utilizar INSERT, CIRCLE, etc. aquí)
;(setvar "PDMODE" 34) ;;mostrar puntos para que puedas verlos demora para Regenerar Dibujo Suprimirla o Dejarla
;(command "_REGEN")
(setvar "OSMODE" oldos)
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
(princ (strcat (itoa (length PTS)) " intersecciones encontradas."))
(princ)
)
;;
;;-----------------------------------------------
;; Obtén todas las líneas y objetos LWPOLYLINE en el
;; dibujo y volver como un conjunto de selección.
;;
(defun get_all_Lines_as_SS ()
(ssget "_X" '((0 . "LINE,LWPOLYLINE"))))
;;
(princ "\n(get_all_inters_in_SS) función y INTLINES comando cargado.")
(prin1)
Un Saludo
Luis
Luis Alberto Benitez- Mensajes : 112
Fecha de inscripción : 29/03/2016
Re: Hola a todos me podriais ayudar con un lisp que detectara la interseccion de unas lineas con una polilinea?
Hola ACERPONCET, bienvenido al Foro.
Por favor envía o sube al foro el DWG con un ejemplo de como quieres que quede el trabajo del lisp y también el LISP original .
mi correo es
devitg@gmail.com
Enviar un mail no contagia por coronavirus
#QUEDATE EN CASA yo #ME QUEDO EN CASA
Por favor envía o sube al foro el DWG con un ejemplo de como quieres que quede el trabajo del lisp y también el LISP original .
mi correo es
devitg@gmail.com
Enviar un mail no contagia por coronavirus
#QUEDATE EN CASA yo #ME QUEDO EN CASA
Temas similares
» Puntos interseccion lineas y polilineas
» Ayuda con Lisp suma de lineas y polilineas
» Ayuda con un lisp para poli-líneas
» Dudas sobre unas funciones de internet
» Sumandome a este nuevo grupo
» Ayuda con Lisp suma de lineas y polilineas
» Ayuda con un lisp para poli-líneas
» Dudas sobre unas funciones de internet
» Sumandome a este nuevo grupo
Página 1 de 1.
Permisos de este foro:
No puedes responder a temas en este foro.
|
|