Lisp calcul bas ortho

[fradiqueluis]

Bonjour à tous,

 

Je suis à la recherche d'une routine en lisp. je ne sais si quelqu'un a ça sous la main?

 

Je recherche un moyen de calculer directement une base orthogonal.

 

Par pointage sur plan. j'aimerai donner deux points de base que je vais nommer A-B.

 

Depuis cette base j'aimerai calculer un point C qui serait perpendiculaire a la base A-B.

 

Avec une cote abscisse depuis A et une ordonnée depuis la base A-B (la cote qui se trouve sur la gauche AB est négative et la cote sur la droite de la base est positive)

 

J'espère m'être bien expliqué.

 

Merci et j'espère que quelqu'un pourra m'aider

[(gile)]

Salut,

 

C'est pas très clair...

Si tu veux un point C tel que le segment AC soit perpendiculaire au segment AB dans le plan XY, ça n'est pas trop compliqué.

Pour faire faire une rotation anti-horaire de 90° à un vecteur 2D de coordonnées (X, Y) il suffit de créer un vecteur de coordonnées (-Y, X).

Pour trouver le point C, on va calculer les coordonnées du vecteur de A à B, puis soustraire la coordonnées Y de ce vecteur à la coordonnées X de A et ajouter la coordonnées X du vecteur à la coordonnées Y de A.

 

(and
 (setq A (getpoint "\nPoint A: "))
 (setq B (getpoint A "\nPoint B: "))
 (setq C (list (- (car A) (- (cadr B) (cadr A))) ; xA - yAB
               (+ (cadr A) (- (car B) (car A)))  ; yA + xAB
         )
 )
 (command "_.line" "_non" B "_non" A  "_non" C "")
)

[DenisHen]

Salut à tous.

 

Je pense que fradiqueluis désire plus faire un point C dans le segment AB puis un point D perpendiculaire au segment AB depuis le point C.

 

J'ai écris ça, mais ça ne fonctionne que dans un sens... :

;;;ligne de cumul pour fradiqueluis de CadXP.com
(defun c:cumulAB ()
 (setq p1     (getpoint "\nPoint A : ")
       p2     (getpoint p1 "\nPoint B: ")
       Distp3 (getreal "\nEntrer la distance sur A-B :")
       Distp4 (getreal "\nDistance depuis A-B :")
 ) ;_ Fin de setq
 (setq old_osmde (getvar "osmode"))
 (setvar "osmode" 0)
 (princ Distp4)
 (if (< Distp4 0.0)
   (progn (setq p3 (polar p1 (angle p1 p2) Distp3))
          (setq p4 (polar p3 (+ (angle p1 p2) (/ pi 2)) Distp4))
   ) ;_ Fin de progn
   (progn (setq p3 (polar p1 (angle p1 p2) Distp3))
          (setq p4 (polar p3 (+ (angle p2 p1) (/ pi 2)) Distp4))
   ) ;_ Fin de progn
 ) ;_ Fin de if
 (command "_.line" p3 p4 "")
 (setvar "osmode" old_osmde)
 (princ)
) ;_ Fin de defun

[fradiqueluis]

https://www.dropbox.com/s/2ixdtvhd91ysiua/Fichier%2013.12.17%2012%2044%2054.jpeg?dl=0

 

 

Merci aux deux d'avoir pris le temps de me répondre. J'ai pas de quoi tester vos codes aujourd'hui. Peut être que un de ces codes réponds à mon besoin.

 

Je voulais quand même vous montrer mon besoin sur une image, mais j'arrive pas a la mettre en réponse.

 

Si vous avez 5 minutes pour télécharger l'image en suivant le liens au dessus.

 

Un grand merci

[fradiqueluis]

Plus de précision dans l’image le point que je cherche a calculé c’est le point P en rouge. Les côtes données sont toujours depuis le premier point de la base.

 

Merci

[DenisHen]

Re...

 

Je pense que ce qui suit est "exactement" ce que tu cherches...:

;;;Cumul sur ligne de base pour fradiqueluis de CadXP.com
(defun c:cumulAB (/ old_osmde p1 p2 p3 p4 Distp3 Distp4)
 (princ "\nDéveloppé par Denis H. (version:1.0)")
 (setq p1     (getpoint "\nPoint A : ")
       p2     (getpoint p1 "\nPoint B: ")
       Distp3 (getreal "\nEntrer la distance sur A-B :")
       Distp4 (getreal "\nDistance depuis A-B :")
       Distp4 (* Distp4 -1.0)
 ) ;_ Fin de setq
 (setq old_osmde (getvar "osmode"))
 (setvar "osmode" 0)
 (setq p3 (polar p1 (angle p1 p2) Distp3))
 (setq p4 (polar p3 (+ (angle p1 p2) (/ pi 2)) Distp4))
 (command "_.line" p3 p4 "")
 (setvar "osmode" old_osmde)
 (princ)
) ;_ Fin de defun

[(gile)]

Je n'avais effectivement rien compris.

 

À mon avis, le plus simple serait, sans LISP, de lancer la commande SCU (_UCS) spécifier les points A (origine) et B (point sur l'axe X) puis un point à droite du segment AB (axe X).

 

Sinon, en LISP :

(defun c:test1 (/ a b x y c)
 (and
   (setq a (getpoint "\nPoint A: "))
   (setq b (getpoint a "\nPoint B: "))
   (setq x (getreal "\nAbscisse: "))
   (setq y (getreal "\nOrdonnée: "))
   (setq c (polar (polar a (angle a B) x)
	   (+ (angle a B) (* pi 0.5))
	   (- y)
    )
   )
   (command "_point" "_non" c)
 )
 (princ)
)

 

ou, plus directement :

(defun c:test2 (/ a b x y c)
 (and
   (setq a (getpoint "\nPoint A: "))
   (setq b (getpoint a "\nPoint B: "))
   (setq x (getreal "\nAbscisse: "))
   (setq y (getreal "\nOrdonnée: "))
   (setq c (polar a
	   (+ (angle a B) (atan (- y) x))
	   (sqrt (+ (* x x) (* y y)))
    )
   )
   (command "_point" "_non" c)
 )
 (princ)
)

[DenisHen]

Effectivement... C'est plus "simple", mais j'évite presque toujours de toucher aux SCU... ;)

 

Trop "dangereux"... Pour moi :(

[bonuscad]

Comme dit (gile) la commande SCU (option 3p par exemple) répondrait à ta question.

 

Néanmoins si tu désire avoir les réponses des coordonnées sans avoir à créer des SCU, alors il faut passer par des matrices de transformation.

Par exemple ceci devrait fonctionner.

 

(defun transpts (apt matrix / )
 (list
   (+
     (* (car (nth 0 matrix)) (car apt))
     (* (car (nth 1 matrix)) (cadr apt))
     (* (car (nth 2 matrix)) (caddr apt))
     (cadddr (nth 0 matrix))
   )
   (+
     (* (cadr (nth 0 matrix)) (car apt))
     (* (cadr (nth 1 matrix)) (cadr apt))
     (* (cadr (nth 2 matrix)) (caddr apt))
     (cadddr (nth 1 matrix))
   )
   (+
     (* (caddr (nth 0 matrix)) (car apt))
     (* (caddr (nth 1 matrix)) (cadr apt))
     (* (caddr (nth 2 matrix)) (caddr apt))
     (cadddr (nth 2 matrix))
   )
 )
)
(defun v_matr (dpt alphax alphay alphaz echx echy echz / )
 (list
   (list
     (* echx (cos alphaz) (cos alphay))
     (- (sin alphaz))
     (sin alphay)
     (car dpt)
   )
   (list
     (sin alphaz)
     (* echy (cos alphaz) (cos alphax))
     (- (sin alphax))
     (cadr dpt)
   )
   (list
     (- (sin alphay))
     (sin alphax)
     (* echz (cos alphax) (cos alphay))
     (caddr dpt)
   )
   (list 0.0 0.0 0.0 1.0)
 )
)
(defun C:MY_REF ( / pt_base pt_ori pt_x pt)
 (initget 9)
 (setq pt_base (getpoint "\nPoint de reference?: "))
 (initget 9)
 (setq pt_ori (getpoint pt_base "\nPoint d'orientation?: "))
 (while (setq pt_x (getpoint "\nPoint voulu dans cette reference?: "))
   (setq
     transform (v_matr (mapcar '- (trans pt_base 1 0)) 0.0 0.0 0.0 1.0 1.0 1.0)
     pt (transpts (trans pt_x 1 0) transform)
     transform (v_matr '(0.0 0.0 0.0) 0.0 0.0 (angle (trans pt_base 1 0) (trans pt_ori 1 0)) 1.0 1.0 1.0)
     pt (transpts pt transform)
   )
   (princ (strcat "\nX=" (rtos (car pt)) " Y=" (rtos (cadr pt)) " Z=" (rtos (caddr pt))))
 )
 (prin1)
)

[DenisHen]

Re...

 

Mais je ne pense pas qu'il faille cherché aussi compliqué... Bien que ce soit très intéressant.

Je pense que fradiqueluis n'a besoin que d'une droite, voir même que d'un point...

 

J'ai donc ajouter un (while pour ne saisir qu'une seule fois A et B :

;;;Cumul sur ligne de base pour fradiqueluis de CadXP.com
(defun c:cumulAB (/ old_osmde p1 p2 p3 p4 Distp3 Distp4)
 (princ "\nDéveloppé par Denis H. (version:1.1)")
 (setq p1 (getpoint "\nPoint A : ")
       p2 (getpoint p1 "\nPoint B: ")
 ) ;_ Fin de setq
 (while (/= (setq Distp3 (getreal "\nEntrer la distance sur A-B :")) nil)
   (setq Distp4 (getreal "\nDistance depuis A-B :"))
   (setq old_osmde (getvar "osmode"))
   (setvar "osmode" 0)
   (setq p3 (polar p1 (angle p1 p2) Distp3))
   (setq p4 (polar p3 (- (angle p1 p2) (/ pi 2)) Distp4))
   (command "_.line" p3 p4 "")
   (setvar "osmode" old_osmde)
 ) ;_ Fin de while
 (princ)
) ;_ Fin de defun

[(gile)]

Ah oui, on peut aussi le faire dans l'autre sens (comme bonuscad).

Mais si, comme il semble, on est en 2D, la trigonométrie suffit, on peut se passer des matrices.

 

(defun c:MY_REF (/ a b c d e)
 (if
   (and
     (setq a (getpoint "\nPoint A: "))
     (setq b (getpoint a "\nPoint B: "))
     (not (equal a b 1e-9))
   )
    (while (setq c (getpoint "\nPoint C: "))
      (setq d (distance a c)
     e (- (angle a B) (angle a c))
      )
      (princ (strcat "\nAbscisse: "
	      (rtos (* d (cos e)))
	      " YOrdonnée: "
	      (rtos (* d (- (sin e))))
      )
      )
    )
 )
 (princ)
)

[DenisHen]

Oops. Je pense m'être trompé largement...

 

Effectivement, il clique un point et il faut ressortir les deux distances Delta X et Delta Y...

 

J'ai vu le problème à l'envers... Dommage, j'étais fier de mon truc... :(

[(gile)]

Oops. Je pense m'être trompé largement...

 

Effectivement, il clique un point et il faut ressortir les deux distances Delta X et Delta Y...

 

J'ai vu le problème à l'envers... Dommage, j'étais fier de mon truc... :(

 

Ce n'est pas sûr du tout que tu te sois trompé, j'ai répondu en premier dans le même sens.

Il faut dire que la demande est quelque peu confuse...

[fradiqueluis]

Ce que cherche à faire c’est sortir les coordonnées du point rouge. Pour ceux qui son du métier géomètre et qui connaissent l’équerre à prisme. C’est le même principe. Je connais les coordonnées des deux points de la base, je connais aussi la distance depuis le point A vers la perpendiculaire du point P et aussi le décalage depuis la perpendiculaire et le point P. J’espère que ces nouvelles explications vont mieux vous guider. Demain je vais pouvoir tester vos codes, je ne manquerai pas de vous répondre si je trouve mon bonheur bonne soirée

[(gile)]

Avec les matrices (pour le fun) ;)

 

;; MXV
;; Applique une matrice de transformation à un vecteur -Vladimir Nesterovsky-
(defun mxv (m v)
 (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
)

;; TRP
;; Transpose une matrice -Doug Wilson-
(defun trp (m) (apply 'mapcar (cons 'list m)))

;; ROTMAT
;; Retourne la matrice de rotation 2D
(defun rotmat (ang)
 (list
   (list (cos ang) (- (sin ang)))
   (list (sin ang) (cos ang))
 )
)

;; Applique la matrice de transformation et le déplacement au point
(defun transform (pt mat disp)
 (mapcar '+ (mxv mat pt) disp)
)

;; Obtenir le point dans le SCU courant
(defun c:FOO (/ a b x y c)
 (if
   (and
     (setq a (getpoint "\nPoint A: "))
     (setq b (getpoint a "\nPoint B: "))
     (setq x (getreal "\nAbscisse: "))
     (setq y (getreal "\nOrdonnée: "))
   )
    (progn
      (setq c (transform (list x (- y)) (rotmat (angle a B)) a))
      (command "_point" "_non" c)
      (terpri)
      (princ c)
    )
 )
 (princ)
)

;; Obtenir l'abscisse et l'ordonnée du point spécifié
(defun c:BAR (/ a b m v c)
 (if
   (and
     (setq a (getpoint "\nPoint A: "))
     (setq b (getpoint a "\nPoint B: "))
   )
    (progn
      (setq m (trp (rotmat (angle a B)))
     v (mapcar '- (mxv m a))
      )
      (while (setq c (getpoint "\nPoint C: "))
 (setq c (transform c m v))
 (princ	(strcat	"\nAbscisse: "
		(rtos (car c))
		" Ordonnée: "
		(rtos (- (cadr c)))
	)
 )
      )
    )
 )
)

[DenisHen]

Salut.

 

Pour ceux qui son du métier géomètre et qui connaissent l’équerre à prisme. C’est le même principe.

Justement, je pensais que c'était pour reporter un levé à l'équerre optique, mais c'est le contraire... ;)

[fradiqueluis]

bonjour à tous je vous remercie d'avoir pris le temps de me lire et m'aider.

 

J'ai trouvé mon bonheur dans vos codes. Quel le problème soit dans un sens ou un autre j'avais besoin de toute façon que le problème soit vu ainsi.

 

Mon besoin premier et donc de construire avec des cotes.

 

Le codes de Gile et DenisHen réponds bien au problème.

 

J'ai bien le code de gile simple et court. Par contre j'aimerai bien qu'il continue en boucle comme comme celui de DenisHen.

 

J'essaye de faire un mixte des deux mais je pèche à quelque part:

 

(defun c:Base_ortho (/ a b x y c)

(if

(and

(setq a (getpoint "\nPoint A: "))

(setq b (getpoint a "\nPoint B: "))

)

(while (setq x (getreal "\nAbscisse: "))

(setq y (getreal "\nOrdonnée: "))

(setq c (polar a

(+ (angle a B) (atan (- y) x))

(sqrt (+ (* x x) (* y y)))

)

)

(command "_point" "_non" c)

)

(princ)

)

 

 

 

 

Après j'ai bien aimé le code qui permet de sortir les cotes pour pouvoir implanter sur le terrain du coup je garde sous la main.

 

 

 

 

Un grand merci

 

 

 

 

 

[(gile)]

Salut,

 

(defun c:BASE_ORTHO (/ a b x y c)
 (if
   (and
     (setq a (getpoint "\nPoint A: "))
     (setq b (getpoint a "\nPoint B: "))
   )
    (while
      (and
 (setq x (getreal "\nAbscisse: "))
 (setq y (getreal "\nOrdonnée: "))
      )
(setq c	(polar a
	       (+ (angle a B) (atan (- y) x))
	       (sqrt (+ (* x x) (* y y)))
	)
)
(command "_point" "_non" c)
    )
 )
 (princ)
)

 

Encore une fois, pour faire ça sans LISP, il suffit de lancer la commande SCU (_UCS) pour définir un SCU correspondant à ta base orthogonale, puis de lancer la commande point en spécifiant les points par "abscisse, ordonnée".

 

Commande: SCU

Nom du SCU courant: *GENERAL*

Spécifiez l'origine du SCU ou [Face/NOMmé/OBjet/Précédent/Vue/Général/X/Y/Z/axEZ] : cliquer sur A

Spécifiez un point sur l'axe X ou : cliquer sur B

Spécifiez un point sur le plan XY ou : cliquer un point à droite du vecteur AB

Commande: POINT

Modes point courants: PDMODE=2 PDSIZE=0.0000

Spécifiez un point: entrer : abscisse,ordonnée

[fradiqueluis]

Encore une fois j'aimerai vous remercier pour votre aide...

 

Bonne journée