Flèche vecteurs pour développeurs

[Invité Patrick]

;|

Programme : ARROWVEC.LSP

Fonction : Dessine une flèche faite de vecteurs pour référencer une position à l'écran. Ce programme est destiné aux développeurs LISP pour être intégré comme routine dans leurs développements. Il n'est pas destiné à être utilisé tel quel par un utilisateur final.

Exemple d'utilisation: indiquer par une flèche la position d'un point cliqué par l'utilisateur en réponse à une fonction (getpoint)

Paramètres: pos est un point X,Y / mode est le numéro de couleur souhaité

Auteur : ©1991 Copyright Patrick EMIN patrick@cortexmail.com

Version 1.00 : 1991

|;

(defun arrowvec(pos mode / prev next height)
  (setq height (/ (getvar "VIEWSIZE") 6000) prev pos)
  (mapcar '(lambda (x)
     (setq next (list (+ (nth 0 pos) (* height (nth 0 x))) (+ (nth 1 pos) (* height (nth 1 x)))))
     (grdraw prev next mode)
     (setq prev next)
  ); end of lambda definition
  (list '(-200 200) '(-200 100) '(-500 150) '(-400 0) '(-500 -150) '(-200 -100) '(-200 -200) '(0 0))
);end of mapcar
);end of defun

[Serge]

Patrick,

 

Si je peux me permettre une amélioration. C'est plus facile à comprendre si on a une fonction qui l'appelle. La commande TEST ci-dessous demande un point, un angle de rotation et une taille relative à l'écran. À la fin, je fais un redrawall qui efface la flèche

 

(defun arrowvec (

pos angRadians color scale

/ height next point2d prev x y

)

(setq height (* scale (getvar "viewsize") 0.002)) ; La flèche fait 500 unités de long (1/500 = 0.002)

(setq prev pos)

(mapcar

'(lambda (point2D)

;; Coordonnées selon le modèle horizontal, à échelle ajustée

(setq x (* height (nth 0 point2D)))

(setq y (* height (nth 1 point2D)))

(setq rayon (sqrt (+ (* x x) (* y y))))

(setq ang (if (equal x 0 1e-14) pi (atan (/ y x))))

 

;; Même coordonnées mais pivotées selon l'angle demandé

(setq ang (+ ang angRadians))

(setq x (* rayon (cos ang)))

(setq y (* rayon (sin ang)))

 

;; Même coordonnées mais décalées de pos

(setq x (+ x (nth 0 pos)))

(setq y (+ y (nth 1 pos)))

(setq next (list x y))

 

(grdraw prev next color)

(setq prev next)

)

(list '(-200 200) '(-200 100) '(-500 150) '(-400 0) '(-500 -150) '(-200 -100) '(-200 -200) '(0 0))

)

)

 

(defun c:test (

/ angRadians color point scale

)

;; Color est un entier

;; -1 = encre XOR, 1 à 255 sont des couleurs ACI

(setq color -1) ; Flèche de couleur XOR

(setq point (getpoint "\nMontrez le point ciblé par la flèche: "))

(setq angRadians (getorient point "\nMontrez l'angle de la flèche: "))

(initget (+ 2 4)) ; Non zéro, non négatif

(setq scale (getreal "\nTaille relative de l'écran (3 à 10% suggéré) <5>: "))

(if (not scale) (setq scale 5.0)) ; Normalement, le programmeur devrait valider les valeurs

(if (> scale 50) (setq scale 50))

(setq scale (* scale 0.01)) ; Pourcentage oblige

 

(arrowvec point angRadians color scale)

(getstring "\nPause... Tapez sur Enter pour continuer")

(command "_redrawall")

(princ)

)

 

Serge

[Invité Patrick]

Les améliorations sont les bienvenues!

[Serge]

Patrick,

 

Coquille:

 

Remplacer

(setq ang (if (equal x 0 1e-14) pi (atan (/ y x))))

 

par

(setq ang (if (not (equal x 0 1e-14)) (atan (/ y x)) (* pi 0.5 (if (< y 0) -1 1))))

 

Ça ne changeait rien dans le code de la flèche, mais c'est pour la forme.

 

Serge