Distance mini entre éléments

[Nicolenain]

Bonjour à toutes et à tous

 

Je suis à la recherche d'une routine, ou une commande, qui permet de mesurer la distance minimale entre deux éléments (droite, cercle, arc).

 

D'avance merci,

 

Nico

[(gile)]

Salut,

 

Un petit LISP qui ne fonctionne qu'avec les arcs, cercles et lignes (pas testé en profondeur).

 

(defun c:mindist
      (/ ent1 ent2 typ1 typ2 rslt temp line cen)
 (vl-load-com)
 (and
   (setq ent1 (car (entsel)))
   (setq ent1 (vlax-ename->vla-object ent1))
   (member (setq typ1 (vla-get-ObjectName ent1))
    '("AcDbArc" "AcDbCircle" "AcDbLine")
   )
   (setq ent2 (car (entsel)))
   (setq ent2 (vlax-ename->vla-object ent2))
   (member (setq typ2 (vla-get-ObjectName ent2))
    '("AcDbArc" "AcDbCircle" "AcDbLine")
   )
   (if	(= typ1 typ2 "AcDbLine")
     (if (vlax-invoke ent1 'IntersectWith ent2 acExtendNone)
(setq rslt 0.0)
(setq rslt
       (min (distance (vlax-curve-getStartPoint ent1)
		      (vlax-curve-getClosestPointTo
			ent2
			(vlax-curve-getStartPoint ent1)
		      )
	    )
	    (distance (vlax-curve-getEndPoint ent1)
		      (vlax-curve-getClosestPointTo
			ent2
			(vlax-curve-getEndPoint ent1)
		      )
	    )
	    (distance (vlax-curve-getStartPoint ent2)
		      (vlax-curve-getClosestPointTo
			ent1
			(vlax-curve-getEndPoint ent2)
		      )
	    )
	    (distance (vlax-curve-getEndPoint ent2)
		      (vlax-curve-getClosestPointTo
			ent1
			(vlax-curve-getEndPoint ent2)
		      )
	    )
       )
)
     )
     (progn
(if (= typ1 "AcDbLine")
  (setq	temp ent1
	ent1 ent2
	ent2 temp
  )
)
(if (vlax-invoke ent1 'IntersectWith ent2 acExtendNone)
  (setq rslt 0.0)
  (progn
    (setq cen (vlax-get ent1 'Center))
    (if	(= (vla-get-ObjectName ent1) "AcDbCircle")
      (setq rslt
	     (-	(distance cen
			  (vlax-curve-getClosestPointTo ent2 cen)
		)
		(vla-get-radius ent1)
	     )
      )
      (progn
	(setq line (vla-addLine
		     (if (= (getvar "CVPORT") 1)
		       (vla-get-PaperSpace
			 (vla-get-ActiveDocument
			   (vlax-get-acad-object)
			 )
		       )
		       (vla-get-ModelSpace
			 (vla-get-ActiveDocument
			   (vlax-get-acad-object)
			 )
		       )
		     )
		     (vla-get-Center ent1)
		     (vlax-3d-point
		       (vlax-curve-getClosestPointTo ent2 cen)
		     )
		   )
	)
	(if (vlax-invoke ent1 'IntersectWith line acExtendNone)
	  (setq
	    rslt (- (distance
		      cen
		      (vlax-curve-getClosestPointTo ent2 cen)
		    )
		    (vla-get-radius ent1)
		 )
	  )
	  (setq	rslt
		 (min (distance	(vlax-curve-getStartPoint ent1)
				(vlax-curve-getClosestPointTo
				  ent2
				  (vlax-curve-getStartPoint ent1)
				)
		      )
		      (distance	(vlax-curve-getEndPoint ent1)
				(vlax-curve-getClosestPointTo
				  ent2
				  (vlax-curve-getEndPoint ent1)
				)
		      )
		 )
	  )
	)
	(vla-delete line)
      )
    )
  )
)
     )
   )
 )
 (and rslt
      (alert (strcat "Distance minimum : " (rtos rslt)))
 )
 (princ)
) 

 

[Edité le 22/6/2007 par (gile)]

[Nicolenain]

Bonjour (gile)

 

Merci pour le lisp.

Je le teste, et je te tiens au courant.

 

Nico