Seleccion Bloques Intersectados

Quizás 0.1 valga para este caso pero creo que es mejor poner una cantidad proporcional a la longitud de cada línea como el 10% o el 5%
Prueba ahora con esta nueva versión

Código:

(defun c:interc(/ +d scapa cp ss ss1 ss2)
;; diciem 2017 by Nolo V3 con el 10% de proximidad para
;; http://acadhispano.foroargentina.net/t149-seleccion-bloques-intersectados
(defun cp (p) (list (car p)(cadr p)))
(defun scapa ( pregunta / ent capa)
(if (setq ent (entsel(strcat (chr 10) pregunta)))
(setq capa (cdr(assoc 8 (entget (car ent)))))
))
(defun +d ( l2p / pr d ang1 ang2 )
(setq d (*(distance(car l2p)(cadr l2p)) 0.1);;10% + o poner 0.1 directamente
 pr (mapcar 'cp l2p)
 ang1 (angle (car pr)(cadr pr))
 ang2 (angle (cadr pr)(car pr))
 pr (list
 (polar (car pr) ang2 d)
 (polar (cadr pr) ang1 d) )
))
(sssetfirst)
(while (not (and
 (setq capa1 (scapa "Capa donde seleccionar : "))
 (setq capa2 (scapa "Capa para buscar intersecciones :"))
 ))
(princ(strcat" Error"(chr 10) "Intentelo de nuevo ..."))
)

(if (progn
 (princ (strcat (chr 10)"Seleccionar lineas en capas -"capa1"- y -"capa2"- : "))
 (setq ss (ssget (list'(0 . "LINE") (cons 8 (strcat capa1","capa2) ))))
 )
(progn
(setq ss (vl-remove-if-not '(lambda(a)(=(type a)'ename)) (apply 'append (ssnamex ss)))
 ss (mapcar '(lambda(a)(mapcar 'cdr
 (vl-remove-if-not '(lambda(b) (member (car b) '(-1 8 10 11))) (entget a))))
 ss)
 ss1 (mapcar 'reverse(vl-remove-if '(lambda(a) (= (cadr a)capa2))ss))
 ss2 (mapcar 'reverse(vl-remove-if '(lambda(a) (= (cadr a)capa1))ss))
 ss (ssadd)
 ss1 (mapcar '(lambda(a)(append (+d (cddr(reverse a)))(cddr a))) ss1)
)
;;; busqueda de intersecciones
(foreach a ss1
(if (vl-remove nil
 (mapcar '(lambda(b)(inters (cp(car a))(cp(cadr a))(cp(car b))(cp(cadr b)))) ss2))
 (ssadd (last a) ss )
))
(sssetfirst ss ss)
(princ (strcat(chr 10)(itoa (sslength ss)) " intersecciones"))
)
(princ (strcat (chr 10)"No hay selección de líneas en las capas..."))
)
(princ)
)

A mi ahora el resultado me parece mas coherente
De todas formas, si quieres ver el resultado solo con 0.1, cambia la línea que pone

Código:

(setq d (*(distance(car l2p)(cadr l2p)) 0.1);;10% + o poner 0.1 directamente

por esta otra

Código:

(setq d   0.1 ;;;;(*(distance(car l2p)(cadr l2p)) 0.1);;10%

Otra novedad que afectaría también a la rutina que preparé para SushyM de los bloques, es que parece que se necesita refrescar  la memoria de entidades seleccionadas en autocad poniendo un (sssetfirst) al principio de la rutina porque si no, ademas de cuando el zoom es muy pequeño, algunas otras veces, no queda reflejada la selección en pantalla aunque el zoom sea el adecuado a la escala.

Edito y lo corrijo en la última rutina de selección de bloques

Un saludo

Estimado nolo, gracias por el apoyo y me ha parecido muy interesante la forma como has solucionado este tema de las falsas intersecciones.
Te hago esta consulta, hay alguna forma de corregir esas falsas intersecciones para que realmente se conviertan en intersecciones verdaderas ya que también ahora se que las puedes seleccionar y veo que algunos casos necesitan extenderse y en otras ser cortadas.
Bueno es una idea que se me viene a la mente, talves haya otra forma de plantearlo.

Saludos.

Si no te he entendido mal, lo que quieres es cambiar el punto mas cercano a la intersección por la intersección.
Eso se puede hacer muy fácil si todas las líneas están en el plano
Pruebalo tu con esto, yo no tengo bien localizados los fallos para poder confirmar que funciona adecuadamente

Código:

(defun c:interc2(/ +d scapa cp ss ss1 ss2 ent)
;; diciem 2017 by Nolo V4 con el 10% de proximidad para
;; http://acadhispano.foroargentina.net/t149-seleccion-bloques-intersectados
;; v4 seleccionar y rectificar puntos de intersección
(defun cp (p) (list (car p)(cadr p)))
(defun scapa ( pregunta / ent capa)
(if (setq ent (entsel(strcat (chr 10) pregunta)))
(setq capa (cdr(assoc 8 (entget (car ent)))))
))
(defun +d ( l2p / pr d ang1 ang2 )
(setq d (*(distance(car l2p)(cadr l2p)) 0.1);;10% + o poner 0.1 directamente
 pr (mapcar 'cp l2p)
 ang1 (angle (car pr)(cadr pr))
 ang2 (angle (cadr pr)(car pr))
 pr (list
 (polar (car pr) ang2 d)
 (polar (cadr pr) ang1 d) )
))
(sssetfirst)
(while (not (and
 (setq capa1 (scapa "Capa donde seleccionar : "))
 (setq capa2 (scapa "Capa para buscar intersecciones :"))
 ))
(princ(strcat" Error"(chr 10) "Intentelo de nuevo ..."))
)

(if (progn
 (princ (strcat (chr 10)"Seleccionar lineas en capas -"capa1"- y -"capa2"- : "))
 (setq ss (ssget (list'(0 . "LINE") (cons 8 (strcat capa1","capa2) ))))
 )
(progn
(setq ss (vl-remove-if-not '(lambda(a)(=(type a)'ename)) (apply 'append (ssnamex ss)))
 ss (mapcar '(lambda(a)(mapcar 'cdr
 (vl-remove-if-not '(lambda(b) (member (car b) '(-1 8 10 11))) (entget a))))
 ss)
 ss1 (mapcar 'reverse(vl-remove-if '(lambda(a) (= (cadr a)capa2))ss))
 ss2 (mapcar 'reverse(vl-remove-if '(lambda(a) (= (cadr a)capa1))ss))
 ss (ssadd)
 ss1 (mapcar '(lambda(a)(append (+d (cddr(reverse a)))(cddr a))) ss1)
)
;;; busqueda de intersecciones
(foreach a ss1
(if (setq p (vl-remove nil
 (mapcar '(lambda(b)(inters (cp(car a))(cp(cadr a))(cp(car b))(cp(cadr b)))) ss2))
 )
 (progn
 (setq ent (entget (last a))
 flag (if (>(distance (car p)(car a))(distance (car p)(cadr a)))11 10)
 )
 (entmod (subst (cons flag (car p))(assoc flag ent)ent))
 (ssadd (last a) ss )
 )
))
(sssetfirst ss ss)
(princ (strcat(chr 10)(itoa (sslength ss)) " intersecciones"))
)
(princ (strcat (chr 10)"No hay selección de líneas en las capas..."))
)
(princ)
)

Un saludo y Feliz Navidad

Gracias amigo Nolo, y esperando que hayas pasado felices fiestas agradezco mucho tu apoyo en mi solicitud con respecto a la rutina.