Un LISP pour vérifier que les lignes sont bien parallèles aux axes du SCU ?

[brunomu]

Bonjour Forum !

 

On s’est tous rendu compte un jour, horrifiés, qu’une ligne n’était pas parallèle (ou perpendiculaire) au SCU.

 

Je rêve d’un LISP qui saurait détecter sur commande ce genre de problème, mais je n’ai rien trouvé en faisant une recherche rapide sur le site.

 

Savez-vous si ça existe ?

 

Merci !

 

[Carboleum]

 

J'attaquerai comme ceci:

 

(car (entsel)) -> une ligne cliquée

 

(setq coords (mapcar 'cdr (vl-remove-if-not '(lambda (x) (or (= 10 (car x)) (= 11 (car x)))) (entget (car (entsel)))))) -> les coordonnées des extrémités

 

(apply '* (mapcar '- (car coords) (cadr coords))) -> renvoie 0.0 si la ligne est parrallele à un des axes

[(gile)]

Salut,

 

L'ébauche donnée par carboleum est un bon début, mais ne fonctionnera que dans le SCG.

De plus, il est préférable d'évaluer le résultat avec une tolérance.

 

La commande ORT (ci dessous) met en surbrillance la ligne sous le curseur et affiche ORTHO (en vert) ou PAS ORTHO (en rouge) suivant que la ligne est orthogonale ou non par rapport au SCU courant.

 

(defun c:ort (/ *error* IsOrtho ent text gr pt size norm)
 (vl-load-com)

 (defun *error* (msg)
   (and msg
 (/= msg "Fonction annulée")
 (princ (strcat "Erreur: " msg))
   )
   (and text (entdel text))
   (and ent (redraw ent 4))
   (princ)
 )

 (defun IsOrtho (e)
   ((lambda (v)
      (equal 0. (* (car v) (cadr v)) 1e-9)
    )
     (mapcar '-
      (trans (vlax-curve-getStartPoint e) 0 1)
      (trans (vlax-curve-getEndPoint e) 0 1)
     )
   )
 )

 (while (= (car (setq gr (grread T 14 2))) 5)
   (and text (entdel text) (setq text nil))
   (and ent (redraw ent 4))
   (setq pt (cadr gr))
   (if
     (and
(setq ent (ssget pt '((0 . "LINE"))))
(setq ent (ssname ent 0))
     )
      (progn
 (redraw ent 3)
 (setq size (/ (getvar "VIEWSIZE") 40.)
       norm (trans '(0 0 1) 2 0 t)
       text (entmakex
	      (list
		'(0 . "TEXT")
		(cons 10
		      (trans
			(polar (trans pt 1 2) (* pi 1.75) size)
			2
			0
		      )
		)
		(cons 40 size)
		(cons 7 (getvar 'textstyle))
		(cons 1
		      (if (IsOrtho ent)
			"ORTHO"
			"PAS ORTHO"
		      )
		)
		(cons 62
		      (if (IsOrtho ent)
			3
			1
		      )
		)
		(cons 210 norm)
		(cons 11 (trans '(1 0 0) 2 0 T))
	      )
	    )
 )
      )
   )
 )
 (*error* nil)
)

[brunomu]

Merci à tous les 2 pour vos réponses.

 

J'ai testé le LISP de gile, mais je ne comprends pas bien comment il fonctionne...

 

 

 

L'idée de spécifier la tolérance est très bonne en effet.

 

Autre chose : une fois détecté le non-parallélisme, ce serait bien de pouvoir rectifier l'angle de la ligne concernée, en indiquant à Autocad quelle extrémité reste inchangée...

[(gile)]

Re,

 

J'ai testé le LISP de gile, mais je ne comprends pas bien comment il fonctionne...

 

Je ne sais pas lequel tu as testé (j'ai modifié mon message).

 

En voici un autre (inspiré du dernier ci-dessus)

Tu lances la commande ORT et tu promènes ton curseur sur les lignes.

Si la ligne sous le curseur (mise en surbrillance) est parallèle aux axes du SCU courant "ORTHO" s'affiche en vert, sinon "PAS ORTHO" s'affiche en rouge si tu cliques sur un coté de cette ligne, l'autre extrémité sera déplacée (une seule des coordonnées x ou y est modifiée)

 

Pour la tolérance, tu peux modifier [surligneur]1e-9[/surligneur] dans le code.

1e-9 correspond à 0.000000001 (soit un milliardième ou un micron pour un kilomètre), c'est un bon compromis pour ne pas être géné par les imprécision dues au codage des nombre réels en informatique tout en conservant une précision plus qu'acceptable.

 

(defun c:ort (/ *error* ent text gr pt elst start ent vec isortho size norm)

 (defun *error* (msg)
   (and msg
 (/= msg "Fonction annulée")
 (princ (strcat "Erreur: " msg))
   )
   (and text (entdel text))
   (and ent (redraw ent 4))
   (princ)
 )
 
 (while (member (car (setq gr (grread T 14 2))) '(3 5))
   (and text (entdel text) (setq text nil))
   (and ent (redraw ent 4))
   (setq pt (cadr gr))
   (if
     (and
(setq ent (ssget pt '((0 . "LINE"))))
(setq ent (ssname ent 0))
     )
      (progn
 (redraw ent 3)
 (setq elst  (entget ent)
       start (trans (cdr (assoc 10 elst)) 0 1)
       end   (trans (cdr (assoc 11 elst)) 0 1)
       vec   (mapcar '- end start)
       isortho (equal 0. (* (car vec) (cadr vec)) [surligneur]1e-9[/surligneur])
       size  (/ (getvar "VIEWSIZE") 40.)
       norm  (trans '(0 0 1) 2 0 t)
       text  (entmakex
	       (list
		 '(0 . "TEXT")
		 (cons 10
		       (trans
			 (polar (trans pt 1 2) (* pi 1.75) size)
			 2
			 0
		       )
		 )
		 (cons 40 size)
		 (cons 7 (getvar 'textstyle))
		 (cons 1
		       (if isortho
			 "ORTHO"
			 "PAS ORTHO"
		       )
		 )
		 (cons 62
		       (if isortho
			 3
			 1
		       )
		 )
		 (cons 210 norm)
		 (cons 11 (trans '(1 0 0) 2 0 T))
	       )
	     )
 )
 (if (= 3 (car gr))
   (entmod
     (if (	       (subst
	 (if (		   (cons 11 (trans (list (car end) (cadr start) (caddr end)) 1 0))
	   (cons 11 (trans (list (car start) (cadr end) (caddr end)) 1 0))
	 )
	 (assoc 11 elst)
	 elst
       )
       (subst
	 (if (		   (cons 10 (trans (list (car start) (cadr end) (caddr start)) 1 0))
	   (cons 10 (trans (list (car end) (cadr start) (caddr start)) 1 0))
	 )
	 (assoc 10 elst)
	 elst
       )
     )
   )
 )
      )
   )
 )
 (*error* nil)
)

[richard-c]

Bonjour (gile)

 

je pense que GLOUB veux dire une entité qui a un Z de départ différent du Z de fin.

 

A+

[brunomu]

@gile :

Super ton LISP !

Problème : on doit tester les lignes une par une.

Tu saurais le modifier pour vérifier plusieurs lignes à la fois et identifier les lignes non parallèles à l'axe des X et/ou des Y ?

 

@richard-c :

en fait, je ne me préoccupais pas de ce cas-là, qui existe aussi, mais que je traite par la commande _FLATTEN.