Tracer un rectangle « avec 2 points imposés » ?

[Azerty]

Bonjour.

Après plusieurs recherches infructueuses

... je me permets de demander directement :

 

Existe-t-il un lisp permettant de dessiner un rectangle en 2 points

exemple

A B

D C

en cliquant sur "A" puis "C"

ou "B" puis "D"

 

Mais que cela fonctionne sans être "restreint" par le SCU courant comme la commande RECTANGLE d'origine ??

Par avance, merci.

[philsogood]

hello

il n'est aps possible de traer un rectangle avec 2 points seulement(en revanche pour un carré c'est possible), un troisième point est indispensable

Phil

[nosset]

Le problème est qu'en deux pt il existe une multitude de rectangle possible.

Tout dépend de l'angle.

 

Contrairement à un carré.

[jalna]

Salut

Par trois points (très pratique)

 

(defun c:rct ()
(setq p1 (getpoint "\n 1er point d)u rectangle  "))
(setq p2 (getpoint "\n 2eme point du rectangle  "))
(setq p3 (getpoint "\n 3eme point du rectangle  "))
(setq x1 (car p1))
(setq y1 (cadr p1))
(setq x2 (car p2))
(setq y2 (cadr p2))
(setq xc (* (- x2 x1) (- x2 x1)))
(setq yc (* (- y2 y1) (- y2 y1)))
(setq d1 (sqrt (+ xc yc)))
(setq xv (/ (- y1 y2) d1))
(setq yv (/ (- x2 x1) d1))
(setq x3 (car p3))
(setq y3 (cadr p3))
(setq xx (* (- x3 x2) (- x3 x2)))
(setq yy (* (- y3 y2) (- y3 y2)))
(setq d2 (sqrt (+ xx yy)))
(setq xw (/ (- x3 x2) d2))
(setq yw (/ (- y3 y2) d2))
(setq d (* d2 (+ (* xv xw) (* yv yw))))
(setq x3p (+ x2 (* d xv)))
(setq y3p (+ y2 (* d yv)))
(setq p3b (list x3p y3p))
(setq x4 (+ x3p (- x1 x2)))
(setq y4 (+ y3p (- y1 y2)))
(setq p4 (list x4 y4))
(command "polylign" p1 p2 p3b p4 "c")

 )

[VDH-Bruno]

Bonjour,

 

Mais que cela fonctionne sans être "restreint" par le SCU courant comme la commande RECTANGLE d'origine ??

Par avance, merci.

 

La commande AutoCAD d'origine à une option de rotation pour ne pas être restreint par le SCU.

Spécifiez le premier coin ou [Chanfrein/Elévation/Raccord/Hauteur/Largeur]:

Spécifiez un autre coin ou [Aire/Cotes/Rotation]: R

 

Spécifiez l'angle de rotation ou [Choisir points] <0>:

Spécifiez un autre coin ou [Aire/Cotes/Rotation]:

 

A+

[Azerty]

Bonjour à tous.

J'ai oublié de répondre :unsure:

 

De plus, j'avais mal formulé ... effectivement tracer un rectangle avec seulement 2 points n'est pas possible ; en fait je voulais "imposer" 2 points fixes et avoir en rendu en temps réel pour positionner un 3ème point.

 

Merci pour la suggestion de la commande rotation, qui équivaut à changer le SCU avant d'envoyer la commande. Hors, l'aperçu en temps-réel du rectangle de la commande d'origine est pratique mais la commande est pénible à utiliser dans bien des cas (enfin ... en ce qui me concerne) car 1 seul point reste fixe / imposé.

 

Bref, Jalna MERCI pour ton lisp hyper pratique.

Il faut penser à viser les coins dans un ordre logique de dessin autocadien, et il n'y a pas d'aperçu en temps-réel entre le 2ème et le 3ème point. Mais on s'y fait très vite.

Je m'en sert depuis 1 semaine, je me demande comment j'ai pu vivre sans pendant 10 ans

;)

[jalna]

Bref, Jalna MERCI pour ton lisp hyper pratique.

 

Salut

Je tiens à préciser que ce n'est pas mon lisp mais un lisp don je me sert aussi.

[(gile)]

Salut,

 

Une solution en LISP avec affichage du rectangle pendant la saisie de la largeur (ou troisième point).

L'inconvénient, c'est qu'on perd les accrochages aux objets pour cette saisie, mais on peut entrer une largeur au clavier (la largeur courante s'affiche dans la barre d'état).

 

(defun c:RECT (/ *error* entmodPline p1 p2 dir zdir pline loop gr len str)
 (vl-load-com)

 (defun *error* (msg)
   (grtext)
   (and msg
 pline
 (entdel pline)
 (/= msg "Fonction annulée")
 (princ (strcat "\nErreur: " msg))
   )
   (vla-EndUndoMark
     (vla-get-ActiveDocument (vlax-get-acad-object))
   )
   (princ)
 )

 (defun entmodPline (v)
   (entmod
     (append
(vl-remove-if
  '(lambda (x) (member (car x) '(10 40 41 42 91)))
  (entget pline)
)
(list
  (cons 10 (trans p1 1 zdir))
  (cons 10 (trans p2 1 zdir))
  (cons 10 (trans (mapcar '+ p2 v) 1 zdir))
  (cons 10 (trans (mapcar '+ p1 v) 1 zdir))
)
     )
   )
 )

 (if
   (and
     (setq p1 (getpoint "\nSpécifiez le premier point: "))
     (setq p2 (getpoint p1 "\nSpécifiez le second point: "))
   )
    (progn
      (princ "\nSpécifiez la largeur ou [annUler]: ")
      (vla-StartUndoMark
 (vla-get-ActiveDocument (vlax-get-acad-object))
      )
      (setq dir   (mapcar '- (polar p1 (+ (angle p1 p2) (/ pi 2.)) 1.) p1)
     zdir  (trans '(0. 0. 1.) 1 0 T)
     pline (entmakex
	     (list
	       '(0 . "LWPOLYLINE")
	       '(100 . "AcDbEntity")
	       '(100 . "AcDbPolyline")
	       '(90 . 4)
	       '(70 . 1)
	       (cons 38 (caddr (trans p1 1 zdir)))
	       (cons 10 (trans p1 1 zdir))
	       (cons 10 (trans p2 1 zdir))
	       (cons 10 (trans p2 1 zdir))
	       (cons 10 (trans p1 1 zdir))
	     )
	   )
     loop  T
      )
      (while
 (and (setq gr (grread T 12 0)) (/= (car gr) 3) loop)
  (cond
    ;; modification de la ligne en fonction de la position du pointeur
    ((= 5 (car gr))
     (setq len (gc:DistanceTo (cadr gr) p1 p2))
     (if (minusp (gc:DotProduct dir (mapcar '- (cadr gr) p1)))
       (setq dir (mapcar '- dir))
     )
     (entmodPline
       (gc:ScaleVector dir len)
     )

     ;; affichage dynamique de la longueur dans la barre d'état
     (grtext -1 (strcat "longueur: " (rtos len)))
    )

    ;; clic droit
    ((member (car gr) '(11 25))
     (entdel pline)
     (setq loop	nil
	   pline nil
     )
    )

    ;; Entrée ou Espace
    ((member (cadr gr) '(13 32))
     (cond
       ;; longueur valide
       ((and str (numberp (distof str)))
	(setq loop nil)
	(entmodPline (gc:ScaleVector dir (distof str)))
       )

       ;; annUler
       ((= (strcase str) "U")
	(entdel pline)
	(setq loop nil
	      pline nil
	)
       )

       ;; entrée non valide
       (T
	(princ
	  "\nNécessite un nombre valide ou une saisie au pointeur.
			     \nSpécifiez la largeur ou [annUler]: "
	)
	(setq str "")
       )
     )
    )

    ;; Récupération des entrée au clavier
    (T
     ;; retour/effacer
     (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)))
       )
     )

     ;; affichage sur la ligne commande
     (and str (princ (chr (cadr gr))))
    )
  )
      )
    )
 )
 (*error* nil)
)

;; gc:DistanceTo
;; Retourne la distance du point pt à la droite p1 p2
;;
;; Arguments
;; pt : le point extérieur à la droite
;; p1 : un point sur la droite
;; p2 : un point sur la droite
(defun gc:DistanceTo (pt p1 p2)
 ((lambda (v)
    (/
      (distance '(0. 0. 0.) (gc:CrossProduct (mapcar '- pt p1) v))
      (distance '(0. 0. 0.) v)
    )
  )
   (mapcar '- p2 p1)
 )
)

;; gc:ScaleVector
;; Multiplie le vecteur par un scalaire
;;
;; Arguments
;; v : un vecteur
;; s : un nombre
(defun gc:ScaleVector (v s)
 (mapcar (function (lambda (x) (* x s))) v)
)

;; gc:DotProduct
;; Retourne le produit scalaire de deux vecteurs
;; Arguments
;; v1, v2 : deux vecteurs
(defun gc:DotProduct (v1 v2) (apply '+ (mapcar '* v1 v2)))

;; gc:CrossProduct
;; Retourne le produit vectoriel (vecteur) de deux vecteurs
;; Arguments
;; v1, v2 : deux vecteurs
(defun gc:CrossProduct (v1 v2)
 (list	(- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))
(- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))
(- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))
 )
)

[VDH-Bruno]

Salut Azerty,

 

Visiblement l’option de rotation de la commande de base ne donnant pas complétement satisfaction, donc rapidement pour le jeu un code qui devrait satisfaire le cahier des charges de la demande suivant :

 

De plus, j'avais mal formulé ... effectivement tracer un rectangle avec seulement 2 points n'est pas possible ; en fait je voulais "imposer" 2 points fixes et avoir en rendu en temps réel pour positionner un 3ème point.

;; VDH-Bruno                  Rectangle par 3 points             12/12/2013   
(defun c:R3PT (/ *error* p1 p2 osmode)
 ;; Facultatif (seulement pour un plus beau visuel)
 (ai_sysvar '(("CMDECHO" . 0) ("UCSICON" . 0) ("ORTHOMODE" . 0) ("UCSFOLLOW" . 0))
 )
 ;; Routine d'erreurs
 (defun *error* (msg)
   (and msg (/= msg "Fonction annulée") (princ (strcat "\nErreur: " msg)))
   (command "scu" "_p")
   (ai_sysvar nil)
   (princ)
 )
 ;; Programme principal
 (if (and (setq p1 (trans (getpoint "\nSpécifiez le premier point: ") 1 0))
   (setq
     p2	(trans (getpoint (trans p1 0 1)
			 "\nSpécifiez le second point (rotation,longueur): "
	       )
	       1
	       0
	)
   )
     )
   (progn
     (setq osmode (getvar 'osmode))
     (setvar 'osmode 0)
     (princ "\nSpécifiez le troisième point (hauteur): ")
     (command "scu" (trans p1 0 1) (trans p2 0 1) "")
     (command "_rectang" (trans p1 0 1) ".X" (trans p2 0 1))
     (setvar 'osmode osmode)
     (command pause)
   )
 )
 (*error* nil)
)

 

Avec l’accrochage aux objets visible et un rectangle dessiné dynamiquement au moment de spécifier le 3ème point ;) .

 

A+

 

 

Edit: Oupss! A vouloir aller trop vite j'ai oublié l'invite du troisième point, code corrigé..

Edit bis: Prise en compte de la remarque avec UCSFOLLOW

Edit ter: Ajouté la gestion des accrochages aux objets

Modifié le 12 décembre 2013 par VDH-Bruno

[Olivier Eckmann]

Bonjour,

 

juste pour assurer, je mettrais aussi la variable UCSFOLLOW à 0 au départ pour éviter que la commande SCU envoie un zoom étendu et un regen.

 

Olivier

[VDH-Bruno]

juste pour assurer, je mettrais aussi la variable UCSFOLLOW à 0 au départ pour éviter que la commande SCU envoie un zoom étendu et un regen.

 

Merci pour le retour, j'ai mis à jour le code précédent suivant ta remarque.

A+

[Azerty]

Cela va bientôt faire 10 ans, qu'au fil de besoins divers et variés, je trouve ici des réponses "clés en mains".

Merci à vous tous pour l'implication, le partage et la réactivités !

(si seulement ça pouvait être pareil pour Excel ou autre ...)

 

Puisque vous avez l'air d'aimer les challenges de codage ^^

J'ai testé les 3, j'aurai une petite préférence pour le dernier (de VDH-Bruno) qui conserve l'accrochage-objet.

Par contre celui de (gile) permet d'entrer au clavier une valeur qui respecte la position du curseur souris pour le dessin. Là où le dernier code tient compte de l'ordre des points (et non du curseur) et il faut parfois rentrer une valeur négative pour dessiner la "hauteur" du rectangle dans la direction souhaitée.

Qui va réussir à proposer le meilleur des 2 mondes ? B)

 

PS : c'est déjà très bien ainsi, si vous n'avez pas le temps ça n'est pas grave du tout.

[VDH-Bruno]

Bonsoir Azerty,

 

Là où le dernier code tient compte de l'ordre des points (et non du curseur) et il faut parfois rentrer une valeur négative pour dessiner la "hauteur" du rectangle dans la direction souhaitée.

Si tu substitue l’expression ("UCSICON" . 0) du code précédent par ("UCSICON" . 1), tu verras dans le coin inférieur gauche l’orientation du scu pour t’aider dans le signe de la valeur à entrer, si tu ne souhaites pas spécifier un point.

 

Pour l’anecdote j’avais fait le choix de masquer l’icone du SCU pour masquer sa rotation et l’utilisation du filtre de coordonnées, en jouant avec la variable angbase et quelques autres empêchant la modification visuelle du curseur… La mystification est bluffant sur ma vieille version d’AutoCAD. Hélas avec la trame de fond (quadrillage) des versions plus récentes l’effet est beaucoup moins spectaculaire.

 

 

Qui va réussir à proposer le meilleur des 2 mondes ? B)

Pour ce qu’il est possible de réaliser en dynamique avec émulation de l’accroche objet sans passer par command et PAUSE, sur ce terrain je n’irai pas défier le maître et préfère te renvoyer à la routine grosmode de (gile) avec le lien suivant http://cadxp.com/topic/22617-grread-et-osmode/page__p__122443#entry122443

Au passage sur ce même lien pense à tester DSTAR, tu verras c’est visuellement beau..

 

A+ Bruno