Perpendiculaire à partir d\'un point

Matt666 · le 26 juin 2007

Bonjour à tous !

G une petite demande à vous faire.

En fait c'est surtout pour voir comment les maîtres du lisp ici présents sur ce forum feraient pour créer une routine comme celle qui vient...

Je ne sais pas si ça existe sur Autocad nouvelles versions... Sachez que j'utilise BricsCad, un clone d'Autocad (moteur Intellicad..) qui n'accepte pas les VL, VLA, VLAX... Et quelques trucs du genre "ok_button" et tous ceux qui lui ressemblent (cancel machin...)

Voici donc :

Une routine qui permettrait de tracer une ligne perpendiculaire à partir d'un objet précédemment sélectionné et à partir d'un point sélectionné...

Procédure :

1- On choisit une entité

2- Le point de départ de la ligne

3- La ligne se créée avec une direction vérouillée à la perpendiculaire de l'entité sélectionnée...

Voilà. Je n'ai pas la moindre idée de comment faire cette routine...

Si ce n'est de basculer le SCU, mais ce n'est pas invisible pour l'utilisateur... En plus si on a coché l'option de basculement du dessin lors de la modification du SCU, ça fout un peu la zone...

Voilà... Maîtres du lisp, à vos claviers, je vous donne deux jours :)

Nan, mais si vous pouviez me donner quelques conseils de départ, ce serait assez.... Cool ?

Merci les gens !!!

A bientot.

Matt.

Matt666 · le 26 juin 2007

Whouaaaa chu ceinture orange !!!! Tation...

Bred · le 26 juin 2007

Salut,

1- On choisit une entité
2- Le point de départ de la ligne
3- La ligne se créée avec une direction vérouillée à la perpendiculaire de l'entité sélectionnée...

4- ?

longeur de ligne ?

par sélection d'un point ?

...

Patrick_35 · le 26 juin 2007

Salut

Un exemple vite fait en autolisp

Par défaut, l'angle est toujours à -90 par rapport au sens de la ligne

La longueur de la nouvelle ligne est la longueur de la ligne sélectionnée / 2

(defun c:lper(/ ent pt pt1 pt2)
 (if (setq ent (ssget "_+.:E:s" (list (cons 0 "LINE"))))
   (if (setq pt (getpoint "\nPoint d'origine : "))
     (progn
(setq ent (entget (ssname ent 0))
      ang (angle (trans (cdr (assoc 10 ent)) 0 1) (trans (cdr (assoc 11 ent)) 0 1))
)
(command "_.line" pt (strcat "@" (rtos (/ (distance (cdr (assoc 10 ent)) (cdr (assoc 11 ent))) 2)) "<" (rtos (- (* 180.0 (/ ang pi)) 90.0))) "")
     )
   )
 )
 (princ)
)

@+

bonuscad · le 26 juin 2007

Un lisp ancien réalisé sous une version R14 (sans vlax)

(defun elperr (ch)
(cond
	((eq ch "Function cancelled") nil)
	((eq ch "quit / exit abort") nil)
	((eq ch "console break") nil)
	(T (princ ch))
)
(setvar "cmdecho" v1)
(setvar "blipmode" v2)
(setvar "osmode" v3)
(setvar "orthomode" v4)
(setvar "snapang" v5)
(setvar "aperture" v6)
(setq *error* olderr)
(princ)
)
(defun elevperp ( / v1 v2 v3 v4 v5 v6 olderr x p p1 j)
(setq
	v1 (getvar "cmdecho")
	v2 (getvar "blipmode")
	v3 (getvar "osmode")
	v4 (getvar "orthomode")
	v5 (getvar "snapang")
	v6 (getvar "aperture")
)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(setvar "osmode" 0)
(setvar "snapang" 0)
(setvar "aperture" 3)
(setq olderr *error* *error* elperr)
(cond
	((setq x (nentsel "\nElever la perpendiculaire au segment : "))
		(setq p (osnap (cadr x) "_near"))
		(if (null p) (setq p (osnap (cadr x) "_insert")))
		(setq j (osnap p "_center"))
		(if (null j) (setq j (osnap p "_midpoint")))
		(if (null j) (setq j (osnap p "_endpoint")))
		(if (null j) (setq j (osnap p "_node")))
		(if (null j) (setq j (osnap p "_insert")))
		(setvar "snapang" (angle p j))
		(setvar "orthomode" 1)
		(if (= (setq p1 (getpoint "\nDu point : ")) ())
			(setq p1 p)
		)
		(initget 9)
		(setq j (getpoint p1 "\nJusqu'au point : "))
		(command "_.line" p1 j "")
	)
)
(setq *error* olderr)
(setvar "aperture" v6)
(setvar "snapang" v5)
(setvar "orthomode" v4)
(setvar "osmode" v3)
(setvar "blipmode" v2)
(setvar "cmdecho" v1)
(prin1)
)
(defun c:elp ()
   (elevperp)
)
(defun c:elevperp ()
   (elevperp)
)
(prompt "\nElevperp charge tapez ELEVPERP ou ELP pour l'execution")
(prin1)

Matt666 · le 26 juin 2007

Parfait Bonuscad c'est exactement ce que je voulais merci !

Maintenant, il faut changer qqs petits trucs, mais c'est une excellente base !!

Bred, en fin de compte le 4 est une entrée utilisateur, laisser libre ce dernier point.

On peut saisir la Longueur ou donner un point graphiquement du moment que la ligne commence perpendiculairement à la ligne sélectionnée...

Patrick_35 c'est presque ça aussi, sauf que la routine ne laisse pas le choix de la longueur. Il faut que j'étudie ton lisp, il y a l'air d'y avoir de bonnes choses aussi merci !

Merci à vous trois vous n'avez vraiment pas trainé, comme d'habitude !

Je vous laisserai le code si ça vous intéresse...

A bientot !

Matt.

Patrick_35 · le 26 juin 2007

Je t'ai donné les bases pour faire le lisp selon tes propes besoins car tu n'avais pas indiqué par exemple qu'il fallait demander la longueur, ni si le sens de la ligne a de l'importance et qu'il faut cliquer à droite ou à gauche pour faire la perpendiculaire. D'où mes observations.

@+

(gile) · le 26 juin 2007

Juste pour le défi, une autre méthode avec grread.

La longueur de la perpendiculaire peut être spécifiée à l'aide du pointeur ou au clavier (elle s'affiche "en dynamique" sur la ligne de commande).

(defun c:perp (/ *error* ent dep ang loop per gr pe str)

 (defun *error*	(msg)
   (if	(= msg "Fonction annulée")
     (princ "\n*Annuler*")
     (princ (strcat "\nErreur: " msg))
   )
   (and per (entdel per))
   (princ)
 )

  (if (and
(setq ent (car (entsel "\nSélectionnez la ligne: ")))
(= (cdr (assoc 0 (entget ent))) "LINE")
(setq dep (getpoint "\nPoint de départ de la perpendiculaire :"))
     )
   (progn
     (entmake (list '(0 . "LINE")
	     (cons 10 (trans dep 1 0))
	     (cons 11 (trans dep 1 0))
       )
     )
     (setq per (entlast)
      ang	 (angle	(cdr (assoc 10 (entget ent)))
		(cdr (assoc 11 (entget ent)))
	 )
    loop T
    
     )
     (princ "\nSpécifiez la longueur: ")
     (while (and (setq gr (grread T 12 0)) (/= (car gr) 3) loop)
(cond
  ((= (car gr) 5)
   (setq
     pe	(polar
	  dep
	  (if (minusp (sin (- (angle dep (cadr gr)) ang)))
	    (- ang (/ pi 2))
	    (+ ang (/ pi 2))
	  )
	  (distance dep (cadr gr))
	)
   )
   (entmod
     (subst (cons 11 (trans pe 1 0))
	    (assoc 11 (entget per))
	    (entget per)
     )
   )
   (grtext -1 (rtos (distance dep (cadr gr))))
  )
  ((member (cadr gr) '(13 32))
   (if (and str (numberp (read str)))
     (progn
       (entmod
	 (subst
	   (cons
	     11
	     (trans (polar dep (angle dep pe) (distof str)) 1 0)
	   )
	   (assoc 11 (entget per))
	   (entget per)
	 )
       )
       (setq loop nil)
     )
     (progn
       (princ
	 "\nNécessite un nombre valide ou une saisie au pointeur.
	 \nSpécifiez la longueur: "
       )
       (setq str "")
     )
   )
  )
  (T
   (if (= (cadr gr) 8)
     (or
       (and str
	    (/= str "")
	    (setq str (substr str 1 (1- (strlen str))))
	    (princ (chr 8))
	    (princ (chr 32))
       )
       (setq str nil)
     )
     (or
       (and str (setq str (strcat str (chr (cadr gr)))))
       (setq str (chr (cadr gr)))
     )
   )
   (and str (princ (chr (cadr gr))))
  )
)
     )
   )
 )
 (princ)
)

Matt666 · le 27 juin 2007

Eh ben...

J'avais compris la première routine, assez simple, mais alors celle là j'avoue que je suis complètement largué !!! Vache...

Impressionnant, (gile) !!

Bah oui génial ça fonctionne parfaitement..

Maintenant si tu veux aller encore plus loin, il faudrait pouvoir utiliser cette fonction comme un accrochage, au sein même d'une commande...

Par exemple on tape une commande ligne, on en créé trois ou quatre puis on arrive à vouloir utiliser cette commande.. Peut-on la faire fonctionner directement au sein de la commande ???

Mais j'en demande trop, c'est exactement ce que je voulais, même si "l'énoncé" de base n'était pas très clair (désolé patrick_35).

Encore bravo et un jour peut être j'arriverais à la cheville de vos compétences !!

Adtal as we say here..

Matt666 · le 14 août 2007

Bon j'ai essayé de décrypter un peu ton lisp Gile.

Et, sans vouloir me vanter, je pense en avoir compris 80%.. Content moi...

Mon problème de compréhension vient de la deuxième condition...

Extrait :

((member (cadr gr) '(13 32))
                             (if (and str (numberp (read str)))
                                  (progn
                                       (entmod (subst 
                                                 (cons 41 (read str))
                                                 (assoc 41 (entget ent))
                                                 (entget ent)
                                       ))
                                       (setq loop nil)
                                  )
                                  (progn
                                       (princ
                                            "\nNécessite un nombre valide ou une saisie au pointeur.
                                            \nSpécifiez la longueur: "
                                       )
                                       (setq str "")
                                  )
                             )
                        )

Le petit "(member (cadr gr) '(13 32))", je comprends po...

Ca doit être le GRREAD qui prend un code 13 ou 32, mais je vois pas ce que sont ces deux codes...

En fait pour tout te dire, j'ai fait un petit lisp pour m'entrainer à la fonction GRREAD, qui est quand même vachement bien !!

Elle permet de resserrer ou étendre un texte simple.

(defun c:stretch ()
    (defun erreur (msg)
         (if (= msg "Fonction annulée")
              (princ "\n*Annuler*")
              (princ (strcat "\nErreur: " msg))
         )
         (and per (entdel per))
         (setq *error* m:err
              m:err nil
         )
    )
    (setq m:err *error*
         *error* erreur
    )
    (if (setq ent (car (entsel "\nSélectionner le texte :")))
         (progn
              (setq dep (cdr (assoc 10 (entget ent))))
              (entmake (list '(0 . "LINE")
                        (cons 10 (trans dep 1 0))
                        (cons 11 (trans dep 1 0))
                   )
              )
              (setq 
                   per (entlast)
                   ang (angle (cdr (assoc 10 (entget ent)))(cdr (assoc 11 (entget ent))))
                   loop T
              )
              (princ "\nSpécifiez la distance : ")
              (while (and (setq gr (grread T 12 0)) (/= (car gr) 3) loop)
                   (cond
                        ((= (car gr) 5)
                             (setq essai (distance dep (cadr gr)))
                             (entmod (subst 
                                       (cons 11 (cadr gr))
                                       (assoc 11 (entget per))
                                       (entget per)
                             ))
                             (entmod (subst 
                                       (cons 41 essai)
                                       (assoc 41 (entget ent))
                                       (entget ent)
                             ))
                        )
                        ((member (cadr gr) '(13 32))
                             (if (and str (numberp (read str)))
                                  (progn
                                       (entmod (subst 
                                                 (cons 41 (read str))
                                                 (assoc 41 (entget ent))
                                                 (entget ent)
                                       ))
                                       (setq loop nil)
                                  )
                                  (progn
                                       (princ
                                            "\nNécessite un nombre valide ou une saisie au pointeur.
                                            \nSpécifiez la longueur: "
                                       )
                                       (setq str "")
                                  )
                             )
                        )
                        (T
                             (if (= (cadr gr) 8)
                                  (or
                                       (and str
                                            (/= str "")
                                            (setq str (substr str 1 (1- (strlen str))))
                                            (princ (chr 8))
                                            (princ (chr 32))
                                       )
                                       (setq str nil)
                                  )
                                  (or
                                       (and str (setq str (strcat str (chr (cadr gr)))))
                                       (setq str (chr (cadr gr)))
                                  )
                             )
                             (and str (princ (chr (cadr gr))))
                        )
                   )
              )
              (entdel per)
    ))
    (setq *error* m:err
         m:err nil
    )
    (princ)
)

Tu remarqueras que la routine est très très largement inspirée de la tienne (voire même pompée !!)...

Maintenant ce que j'aimerais faire c'est de bloquer le déplacement du curseur en fonction de la rotation du texte...

Voilà ! Merci, et à vientot !

Matt.

(gile) · le 14 août 2007

Salut,

Le petit "(member (cadr gr) '(13 32))", je comprends po...

Tape (grread) à la ligne de commande et fait Entrée ou Espace, le "cadr" de la liste retournée sera 13 ou 32.

L'expression :

((member (cadr gr) '(13 32))
(if (and str (numberp (read str)))
(progn
(entmod (subst
(cons 41 (read str))
(assoc 41 (entget ent))
(entget ent)
))
(setq loop nil)
)
(progn
(princ
"\nNécessite un nombre valide ou une saisie au pointeur.
\nSpécifiez la longueur: "
)
(setq str "")
)
)
)

sert donc à récupérer un ne valeur entrée à la ligne de commande et validée par un Entré ou Espace.

La valeur est en fait récupérée par la dernière expression du (cond ...) :

(T
   (if (= (cadr gr) 8)
     (or
       (and str
	    (/= str "")
	    (setq str (substr str 1 (1- (strlen str))))
	    (princ (chr 8))
	    (princ (chr 32))
       )
       (setq str nil)
     )
     (or
       (and str (setq str (strcat str (chr (cadr gr)))))
       (setq str (chr (cadr gr)))
     )
   )
   (and str (princ (chr (cadr gr))))
  )

Nota : pense à déclarer les variables locales :

(defun c:stretch (/ erreur ent dep per ang loop gr essai str) ...)

Si str n'est pas déclarée et que l'utilisteur fait une entrée non valide, la prochaine entrée au clavier viendra ss concaténer à la suite de l'entrée non valide.

(gile) · le 15 août 2007

Salut,

Maintenant ce que j'aimerais faire c'est de bloquer le déplacement du curseur en fonction de la rotation du texte...

Voici un exemple de ce qu'on peut faire, ça devrait fonctionner tant que le plan XY du SCU courant est parallèle au SCO du texte.

J'ai remplacé la création d'une entité ligne (ligne élastique) par un (grdraw ...).

(defun c:stretch (/ erreur dep box larg fact ang per loop gr essai str)
 (defun erreur	(msg)
   (if	(= msg "Fonction annulée")
     (princ "\n*Annuler*")
     (princ (strcat "\nErreur: " msg))
   )
   (redraw)
   (setq *error* m:err
  m:err	nil
   )
 )
 (setq	m:err	*error*
*error*	erreur
 )
 (if (setq ent (car (entsel "\nSélectionner le texte :")))
   (progn
     (setq dep	 (trans (cdr (assoc 10 (entget ent))) ent 1)
    box	 (textbox (entget ent)) ;_ coordonnées de la boite englobante du texte
    larg (- (caadr box) (caar box)) ;_ largeur du texte
    fact (cdr (assoc 41 (entget ent))) ;_ facteur de largeur du texte
    ang	 (- (cdr (assoc 50 (entget ent))) ;_ angle du texte dans le SCU courant
	    (angle '(0 0 0) (getvar "UCSXDIR"))
	 )
    loop T
     )
     (princ "\nSpécifiez le facteur de largeur : ")
     (while (and (setq gr (grread T 12 0)) (/= (car gr) 3) loop)
(cond
  ((= (car gr) 5)
   (setq essai (distance dep (cadr gr)))
   (redraw)
   (grdraw dep (polar dep ang essai) 255) ;_ ligne élastique
   (entmod (subst
	     (cons 41 (/ (* essai fact) larg))
	     (assoc 41 (entget ent))
	     (entget ent)
	   )
   )
  )
  ((member (cadr gr) '(13 32))
   (if (and str (numberp (read str)))
     (progn
       (entmod (subst
		 (cons 41 (read str))
		 (assoc 41 (entget ent))
		 (entget ent)
	       )
       )
       (setq loop nil)
     )
     (progn
       (princ
	 "\nNécessite un nombre valide ou une saisie au pointeur.
                 \nSpécifiez le facteur de largeur: "
       )
       (setq str "")
     )
   )
  )
  (T
   (if (= (cadr gr) 8)
     (or
       (and str
	    (/= str "")
	    (setq str (substr str 1 (1- (strlen str))))
	    (princ (chr 8))
	    (princ (chr 32))
       )
       (setq str nil)
     )
     (or
       (and str (setq str (strcat str (chr (cadr gr)))))
       (setq str (chr (cadr gr)))
     )
   )
   (and str (princ (chr (cadr gr))))
  )
)
     )
     (redraw)
   )
 )
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)

Matt666 · le 16 août 2007

Raaah la vache ! C'est exactement ce que je voulais faire !! :D

Bon bah j'ai encore du boulot moi !! :)

(grdraw) connais pas, ça a l'air dément !

(textbox) Raaah là là mais c'est génial ce truc !!

(getvar "UCSXDIR") Mais d'où elle sort cette variable !!!

Encore une fois merci pour tout !

C'est vrai que la ligne élastique c'est un peu du bricolage...

Merci aussi pour tes explications à propos du grread maintenant je vois beaucoup mieux.

Pour mieux comprendre ce que tu as fais je vais tenter de faire la même routine avec la hauteur de texte, pour voir... Ou à la limite refaire ce code en cachant ce que tu as fait !!

Reste encore à comprendre ces drôle de (or ou (and en début de code...

genre

(or
(and str (setq str (strcat str (chr (cadr gr)))))
(setq str (chr (cadr gr)))
)
)

Là je bloque... On verra bien !! :o

Et surtout merci de me donner des clefs de programmation du lisp, j'apprécie énormément...

A bientot !

Matt, from Rennes in blood.

(gile) · le 16 août 2007

Reste encore à comprendre ces drôle de (or ou (and en début de code...

C'est un peu une coquetterie, on peut en effet souvent utiliser les opérateurs logique and et or à la place d'une conditionnelle comme if.

(or
(and str (setq str (strcat str (chr (cadr gr)))))
(setq str (chr (cadr gr)))
)

peut très bien s'écrire :

(if str
 (setq str (strcat str (chr (cadr gr))))
 (setq str (chr (cadr gr)))
)

Matt666 · le 17 août 2007

Ah oui D'accord je comprends mieux..

Pour l'instant ça risque de m'embrouiller plus qu'autre chose, mais merci pour cette précision !

Bonne journée !

Matt.

Connexion

Perpendiculaire à partir d\'un point

Messages recommandés

Matt666

Matt666

Bred

Patrick_35

bonuscad

Matt666

Patrick_35

(gile)

Matt666

Matt666

(gile)

(gile)

Matt666

(gile)

Matt666

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante