acad hispano
¿Quieres reaccionar a este mensaje? Regístrate en el foro con unos pocos clics o inicia sesión para continuar.

Hola a todos me podriais ayudar con un lisp que detectara la interseccion de unas lineas con una polilinea?

3 participantes

Ir abajo

Hola a todos me podriais ayudar con un lisp que detectara la interseccion de unas lineas con una polilinea? Empty Hola a todos me podriais ayudar con un lisp que detectara la interseccion de unas lineas con una polilinea?

Mensaje por aserponcet Jue Mar 19, 2020 11:04 am

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.

Hola a todos me podriais ayudar con un lisp que detectara la interseccion de unas lineas con una polilinea? Inters10

aserponcet

Mensajes : 1
Fecha de inscripción : 18/03/2020

Volver arriba Ir abajo

Hola a todos me podriais ayudar con un lisp que detectara la interseccion de unas lineas con una polilinea? Empty Interseccion

Mensaje por Luis Alberto Benitez Vie Mar 20, 2020 10:51 pm

Amigo Fíjate si te Sirve el Siguiente Lisp
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)
Pruebalo y Comenta si realizas alguna mejora al mismo
Un Saludo
Luis

Luis Alberto Benitez

Mensajes : 112
Fecha de inscripción : 29/03/2016

Volver arriba Ir abajo

Hola a todos me podriais ayudar con un lisp que detectara la interseccion de unas lineas con una polilinea? Empty Re: Hola a todos me podriais ayudar con un lisp que detectara la interseccion de unas lineas con una polilinea?

Mensaje por devitg Lun Mar 23, 2020 1:55 pm

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

devitg
Admin

Mensajes : 257
Fecha de inscripción : 16/03/2016
Edad : 75
Localización : CORDOBA ARGENTINA

https://acadhispano.foroargentina.net

Volver arriba Ir abajo

Hola a todos me podriais ayudar con un lisp que detectara la interseccion de unas lineas con una polilinea? Empty Re: Hola a todos me podriais ayudar con un lisp que detectara la interseccion de unas lineas con una polilinea?

Mensaje por Contenido patrocinado


Contenido patrocinado


Volver arriba Ir abajo

Volver arriba

- Temas similares

 
Permisos de este foro:
No puedes responder a temas en este foro.