Puntos interseccion lineas y polilineas

Foreros un saludo... por primera vez por aquí...
Deseos de éxitos en este nuevo año 2020...
Me trae... un conocimiento básico de autocad y casi nulo en LISP...
Gracias... por las ayudas y comentarios...
Tengo varias polilìneas y lineas...
Puedo obtener y registrar (Texto,Excel, etc) por programación todos los puntos de intersección de dos figuras lineales...o una con todas?

Hola . Si. Se puede . Por favor sube tu DWG ejemplo .
También el formato de salida de los datos
o me lo envías a mi correo
devitg@gmail.com

hola yo ando buscando creo ese líos solo requiero de que los puntos aparezcan en las intercesiónes de líneas y polines... podrás ayudarme...

Repito mi mensaje anterior

Hola . Si. Se puede . Por favor sube tu DWG ejemplo .
También el formato de salida de los datos
o me lo envías a mi correo
devitg@gmail.com

Hola a tod@s

1ra rutina de Bill Kramer: ILIN, coloca un objeto POINT en cada intersección de Line y Pline

Código:


(vl-load-com)
;;-----------------------------------------------
;; CDNC5-02.LSP
;; Bill Kramer
;; (modifications and enhancements by CAD Studio, www.cadstudio.cz , 2010-2014)
;;
;; ILSIMPLEMODE = T  for single intersection only  (large coord problem)
;;
;; Find all intersections between objects in
;; the selection set SS.
;;
;; ---------------------------------------------- BEGIN LISTING 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
     )

(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) ; convert coordlist -> pointlist 2D
(while (> (length iPts) 0)
  (setq Pts (cons (list (car iPts)
 (cadr iPts)
 '0.0)
 Pts)
    iPts (cddr iPts)))
 Pts
)

(defun DelDup ( l / x r ) ; remove duplicates
    (while l
        (setq x (car l)
              l (vl-remove x (cdr l))
              r (cons x r)
        )
    )
    (reverse r)
)


  (setq N1 0 ;index for outer loop
 SSL (sslength SS))
  ; Outer loop, first through second to last
  (while (< N1 (1- SSL)) ;  nebo <= ?
    ; Get object 1, convert to VLA object type
    (setq aObj1 (ssname SS N1)
  aObj1 (vlax-ename->vla-object aObj1)
  N2 (1+ N1)) ;index for inner loop
   ; self-intersections:
 (if (vlax-property-available-p aObj1 'Coordinates)(progn ; is it a curve? 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
 ))
    ; Inner loop, go through remaining objects
    (while (< N2 SSL) ; innser loop
      ; Get object 2, convert to VLA object
      (setq aObj2 (ssname SS N2)
    aObj2 (vlax-ename->vla-object aObj2)
    ; Find intersections of Objects
    iPts (vla-intersectwith aObj1
   aObj2 0)
    ; variant result
    iPts (vlax-variant-value iPts))
      ; Variant array has values?
      (if (> (vlax-safearray-get-u-bound iPts 1)
     0)
 (progn ;array holds values, convert it
  (setq iPts ;to a list.
 (vlax-safearray->list iPts))
  ;Loop through list constructing points
;  (setq Pts (iL->L iPts)) ; must be 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 - take only the first intersection
  )
 ))
      (setq N2 (1+ N2))) ;inner loop end
    (setq N1 (1+ N1))) ;outer loop end
  Pts) ;return list of points found
;;-----------------------------------------------   END LISTING 1
;;
;; Remaining lines of code for download version, used to demonstrate and test the utility in Listing 1.
;;
;; Process - Create drawing with intersecting lines and lwpolylines.
;;           Load function set
;;           Run command function INTLINES
;;           Intersections are marked with POINT objects on current layer
;;
(defun C:ILIN ( / SS1 PT ptl oldos)
  (prompt "\nINTLINES running to demonstrate GET_ALL_INTERS_IN_SS function.")
  (setq SS1 (ssget);(ssget "_X");(get_all_lines_as_SS)
 PTS (get_all_inters_in_ss SS1)
        )
  (setq ptl (length PTS)   PTS (deldup PTS)) ; duplicates - shouldn't be any
  (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 ;;Loop through list of points
    (command "_POINT" PT)) ;;Create point object (you can also use INSERT, CIRCLE, etc. here)
  (setvar "PDMODE" 34) ;;display points so you can see them
  (command "_REGEN")
  (setvar "OSMODE" oldos)
  (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
  (princ (strcat (itoa (length PTS)) " intersections found."))
  (princ)
)
;;
;;-----------------------------------------------
;;  Get all lines and lwpolyline objects in the
;;  drawing and return as a selection set.
;;
(defun get_all_Lines_as_SS ()
  (ssget "_X" '((0 . "LINE,LWPOLYLINE"))))
;;

(princ "\n(get_all_inters_in_SS) function and ILIN command loaded.")
(prin1)


2da rutina de SpeedCad: EXPUNTOS. Exporta coordenadas de los objetos POINT seleccionados a un archivo llamado 1expuntos.TXT ubicado en la raíz del disco C

Código:


(defun expunto (/ punto n x archivo)
  (setq puntos (ssget '((0 . "POINT"))))
  (if puntos
    (progn
      (setq n 0
    x 1
      )
      (setq archivo (open "c:\\1expuntos.txt" "w"))
      (repeat (sslength puntos)
 (write-line
  (strcat
;    (itoa x) ;;Identificacion numérica punto en 1era columna
;    ";"
    (rtos (car (cdr (assoc 10 (entget (ssname puntos n)))))
  2
  (getvar "luprec")
    )
    ";"
    (rtos (cadr (cdr (assoc 10 (entget (ssname puntos n)))))
  2
  (getvar "luprec")
    )
 ;;Obtencion 3era coordenada
;    ";"
;    (rtos (caddr (cdr (assoc 10 (entget (ssname puntos n)))))
;  2
;  (getvar "luprec")
;    )
  )
  archivo
 )
 (setq n (1+ n)
      x (1+ x)
 )
      ) ;_repeat
      (close archivo)
    ) ;_progn
  ) ;_if
) ;_defun

(defun c:expuntos ()
  (expunto)
  (prin1)
) ;_defun

(prompt
  "\nNuevo comando EXPUNTOS definido por SpeedCAD (C) 2004"
)
(prin1)


Ambas probadas en Acad 2021 inglés.
Saludos

Excelente Rutina Jademar Gracias por Compartirla.

Hola a tod@s

Luis Alberto Benitez: Suerte que te hayan servido. Por mi parte debo decir que yo sólo las guardé. El mérito es de los desarrolladores, Bill Kramer y SpeedCAD.

Saludos

Jademar Muy bien vale la aclaración ya que fueron los que se quemaron las pestañas para elaborar los mismos.