Aller au contenu
Problème de lien d'inscription (résolu ?) ×

grread et osmode

(gile)

Par (gile)
dans Pour aller plus loin en LISP

 Partager

Messages recommandés

(gile) Proficient

(gile)

Posté(e)
Posté(e)

Salut,

 

En m'inspirant largement de gr_osmode qu'avait fait bonuscad (voir ici, par exemple), j'ai essayé de faire quelque chose pour que l'affichage des "marqueurs AutoSnap" reste le même quelque soit la vue courante (3d).

 

Pour l'affichage, ça semble fonctionner, par contre, j'ai noté un comportement capricieux avec les accrochages PERpendiculaire et TANgente (aussi bien avec la routine de bonuscad qu'avec la mienne).

J'ai donc supprimé ces 2 modes, il reste : extrémité, milieu, centre, nodal, quadrant, intersection, insertion et proche.

 

La fonction GrOsmode requiert comme argument le point retourné par grread (coordonées SCU de la position du curseur).

Elle retourne un point 'osnap' ou nil si à la fin de la boucle aucun n'était actif.

 

Les marqueurs sont des polylignes épaisses crées et supprimées suivant la position du curseur. Une liste des polylignes est stockées dans une variable globale *GrOsnapMarker*. La fonction qui appelle GrOsmode devra donc faire le ménage au cas où il reste un marqueur à la fin de la boucle et dans la gestion d'erreur (en cas d'Echap).

 

Comme la routine est un peu longue, je donnerais un exemple d'utilisation dans le message suivant

 

;; GrOsmode
;; Emuler les accrochages aux objets courants avec grread
;; *GrOsnapMarker* = variable globale contenant une liste des noms d'entités des
;; polylignes figurant le marqueur AutoSnap à supprimer dans la fonction d'appel :
;; (and *GrOsnapMarker* (mapcar 'entdel *GrOsnapMarker*) (setq *GrOsnapMarker* nil))
;;
;; Argument le point retouné par grread (coordonnées SCU du pointeur)
;;
;; Retour : le point retourné par osnap ou nil

(defun grosmode	(pt	/      _end   _mid   _cen   _nod   _qua
	 _int	_ins   _per   _tan   _nea   osmode scl
	 norm	loop   mlst   mstr _mod   result marker
	)

 (defun _end (pt scl norm)
   (list
     (entmakex
(list
  '(0 . "LWPOLYLINE")
  '(100 . "AcDbEntity")
  '(100 . "AcDbPolyline")
  '(8 . "0")
  '(62 . 1)
  '(90 . 4)
  '(70 . 1)
  (cons 43 (* scl 0.2))
  (cons 10 (polar pt (* 1.25 pi) (* (sqrt 2) scl)))
  (cons 10 (polar pt (* 1.75 pi) (* (sqrt 2) scl)))
  (cons 10 (polar pt (* 0.25 pi) (* (sqrt 2) scl)))
  (cons 10 (polar pt (* 0.75 pi) (* (sqrt 2) scl)))
  (cons 210 norm)
)
     )
   )
 )

 (defun _mid (pt scl norm)
   (list
     (entmakex
(list
  '(0 . "LWPOLYLINE")
  '(100 . "AcDbEntity")
  '(100 . "AcDbPolyline")
  '(8 . "0")
  '(62 . 1)
  '(90 . 3)
  '(70 . 1)
  (cons 43 (* scl 0.2))
  (cons 10 (polar pt (* 1.25 pi) (* (sqrt 2) scl)))
  (cons 10 (polar pt (* 1.75 pi) (* (sqrt 2) scl)))
  (cons 10 (polar pt (* 0.5 pi) scl))
  (cons 210 norm)
)
     )
   )
 )

 (defun _cen (pt scl norm)
   (list
     (entmakex
(list
  '(0 . "LWPOLYLINE")
  '(100 . "AcDbEntity")
  '(100 . "AcDbPolyline")
  '(8 . "0")
  '(62 . 1)
  '(90 . 2)
  '(70 . 1)
  (cons 43 (* scl 0.2))
  (cons 10 (polar pt pi scl))
  '(42 . 1.0)
  (cons 10 (polar pt 0.0 scl))
  '(42 . 1.0)
  (cons 210 norm)
)
     )
   )
 )

 (defun _nod (pt scl norm)
   (cons (car (_cen pt scl norm)) (_int pt scl norm))
 )

 (defun _qua (pt scl norm)
   (list
     (entmakex
(list
  '(0 . "LWPOLYLINE")
  '(100 . "AcDbEntity")
  '(100 . "AcDbPolyline")
  '(8 . "0")
  '(62 . 1)
  '(90 . 4)
  '(70 . 1)
  (cons 43 (* scl 0.2))
  (cons 10 (polar pt (* 1.5 pi) scl))
  (cons 10 (polar pt 0.0 scl))
  (cons 10 (polar pt (* 0.5 pi) scl))
  (cons 10 (polar pt pi scl))
  (cons 210 norm)
)
     )
   )
 )

 (defun _int (pt scl norm)
   (list
     (entmakex
(list
  '(0 . "LWPOLYLINE")
  '(100 . "AcDbEntity")
  '(100 . "AcDbPolyline")
  '(8 . "0")
  '(62 . 1)
  '(90 . 2)
  '(70 . 0)
  (cons 43 (* scl 0.2))
  (cons 10 (polar pt (* 1.25 pi) (* (sqrt 2) scl)))
  (cons 10 (polar pt (* 0.25 pi) (* (sqrt 2) scl)))
  (cons 210 norm)
)
     )
     (entmakex
(list
  '(0 . "LWPOLYLINE")
  '(100 . "AcDbEntity")
  '(100 . "AcDbPolyline")
  '(8 . "0")
  '(62 . 1)
  '(90 . 2)
  '(70 . 0)
  (cons 43 (* scl 0.2))
  (cons 10 (polar pt (* 1.75 pi) (* (sqrt 2) scl)))
  (cons 10 (polar pt (* 0.75 pi) (* (sqrt 2) scl)))
  (cons 210 norm)
)
     )
   )
 )

 (defun _ins (pt scl norm)
   (list
     (entmakex
(list
  '(0 . "LWPOLYLINE")
  '(100 . "AcDbEntity")
  '(100 . "AcDbPolyline")
  '(8 . "0")
  '(62 . 1)
  '(90 . 6)
  '(70 . 1)
  (cons 43 (* scl 0.2))
  (cons 10 (polar pt (* 1.5 pi) scl))
  (cons 10 (polar pt (* 1.75 pi) (* (sqrt 2) scl)))
  (cons 10 (polar pt 0.0 scl))
  (cons 10 (polar pt pi scl))
  (cons 10 (polar pt (* 0.75 pi) (* (sqrt 2) scl)))
  (cons 10 (polar pt (* 0.5 pi) scl))
  (cons 210 norm)
)
     )
   )
 )

 (defun _per (pt scl norm)
   (list
     (entmakex
(list
  '(0 . "LWPOLYLINE")
  '(100 . "AcDbEntity")
  '(100 . "AcDbPolyline")
  '(8 . "0")
  '(62 . 1)
  '(90 . 3)
  '(70 . 0)
  (cons 43 (* scl 0.2))
  (cons 10 (polar pt (* 0.75 pi) (* (sqrt 2) scl)))
  (cons 10 (polar pt (* 1.25 pi) (* (sqrt 2) scl)))
  (cons 10 (polar pt (* 1.75 pi) (* (sqrt 2) scl)))
  (cons 210 norm)
)
     )
     (entmakex
(list
  '(0 . "LWPOLYLINE")
  '(100 . "AcDbEntity")
  '(100 . "AcDbPolyline")
  '(8 . "0")
  '(62 . 1)
  '(90 . 3)
  '(70 . 0)
  (cons 43 (* scl 0.2))
  (cons 10 (polar pt (* 1.5 pi) scl))
  (cons 10 pt)
  (cons 10 (polar pt pi scl))
  (cons 210 norm)
)
     )
   )
 )

 (defun _tan (pt scl norm)
   (cons
     (entmakex
(list
  '(0 . "LWPOLYLINE")
  '(100 . "AcDbEntity")
  '(100 . "AcDbPolyline")
  '(8 . "0")
  '(62 . 1)
  '(90 . 2)
  '(70 . 0)
  (cons 43 (* scl 0.2))
  (cons 10 (polar pt (* 0.25 pi) (* (sqrt 2) scl)))
  (cons 10 (polar pt (* 0.75 pi) (* (sqrt 2) scl)))
  (cons 210 norm)
)
     )
     (_cen pt scl norm)
   )
 )

 (defun _nea (pt scl norm)
   (list
     (entmakex
(list
  '(0 . "LWPOLYLINE")
  '(100 . "AcDbEntity")
  '(100 . "AcDbPolyline")
  '(8 . "0")
  '(62 . 1)
  '(90 . 4)
  '(70 . 1)
  (cons 43 (* scl 0.2))
  (cons 10 (polar pt (* 1.25 pi) (* (sqrt 2) scl)))
  (cons 10 (polar pt (* 1.75 pi) (* (sqrt 2) scl)))
  (cons 10 (polar pt (* 0.75 pi) (* (sqrt 2) scl)))
  (cons 10 (polar pt (* 0.25 pi) (* (sqrt 2) scl)))
  (cons 210 norm)
)
     )
   )
 )

 (and *GrOsnapMarker*
      (mapcar 'entdel *GrOsnapMarker*)
      (setq *GrOsnapMarker* nil)
 )
 (setq	osmode (getvar "OSMODE")
scl    (/ (* 1.25 (atoi (getenv "AutoSnapSize")) (getvar "VIEWSIZE"))
	  (cadr (getvar "SCREENSIZE"))
       )
norm   (trans '(0 0 1) 2 0 T)
loop   T
 )
 (if (zerop (logand osmode 16384))
   (mapcar '(lambda (b s)
       (or (zerop (logand b osmode))
	   (setq mlst (cons s mlst))
       )
     )
    '(1 2 4 8 16 32 64 512)
    '("_end" "_mid" "_cen" "_nod" "_qua" "_int" "_ins" "_nea")
   )
 )
 (setq	mstr   (lst2str mlst ",")
result (osnap pt mstr)
 )
 (if result
   (while (and loop mlst)
     (if (equal result (osnap pt (car mlst)))
(setq *GrOsnapMarker*
       (apply (read (car mlst))
	      (list (trans result 1 norm) scl norm)
       )
      loop nil
)
(setq mlst (cdr mlst))
     )
   )
 )
 result
)

;; lst2str
;; Concatène une liste et un séparateur en une chaine
;;
;; Arguments
;; lst : la liste à transformer en chaine
;; sep : le séparateur
;;
;; Exemples
;; (lst2str '(1 2 3) ",") -> "1,2,3"
;; (lst2str '("a" "b" "c") " ") -> "a b c"

(defun lst2str (lst sep)
 (if (cadr lst)
   (strcat (vl-princ-to-string (car lst))
    sep
    (lst2str (cdr lst) sep)
   )
   (vl-princ-to-string (car lst))
 )
)

Gilles Chanteau - gileCAD - GitHub
Développements sur mesure pour AutoCAD

(gile) Proficient

(gile)

Posté(e)
  • Auteur
Posté(e)

Re,

 

Un exemple d'utilisation de grread avec la fonction GrOsmode ci dessus.

J'ai essayé d'en faire aussi un exemple pour montrer certaines possibilités de grread (il y a quelques commentaires dans le LISP)

 

La commande DStar dessine des étoiles régulières (polygones étoilés).

L'utilisateur spécifie le nombre de branches et un point au centre de l'étoile.

Puis le sommet d'une des branches.

C'est là qu'on entre dans la boucle grread, jusqu'à ce que ce point soit spécifié.

Dans cette boucle, il est possible de :

- changer la densité de l'étoile (si le nombre de branches le permet) avec un clic droit

- activer/désactiver le mode ortho avec F8

- activer/désactiver les accrochages aux objets avec F3

- entrer au clavier un point ou la distance depuis le centre (une entrée valide fait sortir de la boucle)

- et bien sûr cliquer un point à l'écran.

 

;;; DSTAR (gile) 2009/03/09
;;; Dessine une étoile

(defun c:dstar (/ *error* makestar br imax ind cen loop gr star str pt prj ospt ang dist)

;;;======================== SOUS ROUTINES LOCALES ========================;;;

 ;; Local *error*
 (defun *error* (msg)
   (or	(= msg "Fonction annulée")
(princ (strcat "Erreur: " msg))
   )
   (and star (entdel star) (setq star nil))
   (and *GrOsnapMarker*
 (mapcar 'entdel *GrOsnapMarker*)
 (setq *GrOsnapMarker* nil)
   )
   (grtext)
   (princ)
 )

 ;; Creation de la polyligne
 (defun makestar (cen ang dist br ind / n zdir lst1 lst2)
   (setq n    (* 2 br)
  zdir (trans '(0 0 1) 1 0 T)
   )
   (and (= (getvar "ORTHOMODE") 1) (setq ang (OrthoRound ang)))
   (repeat br
     (setq
lst1
 (cons
   (polar cen (+ ang (/ (* (setq n (- n 2)) pi) br)) dist)
   lst1
 )
     )
   )
   (repeat br
     (setq lst2
     (cons (inters (nth n lst1)
		   (nth (rem (+ n br (- ind)) br) lst1)
		   (nth (rem (+ n (1- ind)) br) lst1)
		   (nth (setq n (rem (+ n (1- br)) br)) lst1)
	   )
	   lst2
     )
     )
   )
   (entmakex
     (append
(list '(0 . "LWPOLYLINE")
      '(100 . "AcDbEntity")
      '(100 . "AcDbPolyline")
      (cons 90 (* 2 br))
      '(70 . 1)
      (cons 38 (caddr (trans cen 1 zdir)))
      (cons 210 zdir)
)
(mapcar
  (function
    (lambda (pt)
      (cons 10 (trans pt 1 zdir))
    )
  )
  (apply 'append
	 (apply 'mapcar (cons 'list (list lst1 lst2)))
  )
)
     )
   )
 )

;;;======================== MAIN ========================;;;

 (or *StarPointNumber* (setq *StarPointNumber* 5))
 (if (setq br (getint (strcat "\nEntrez le nombre de branches: <"
		       (itoa *StarPointNumber*)
		       ">: "
	       )
       )
     )
   (setq *StarPointNumber* br)
   (setq br *StarPointNumber*)
 )
 (if (< 4 br)
   (progn
     (setq imax (fix (/ (- br 0.5) 2))
    ind	 imax
     )
     (initget 1)
     (setq cen	 (getpoint "\nSpécifiez le centre de l'étoile: ")
    loop T
     )
     (princ
"\nSpecifiez le sommet d'un branche (ou la distance depuis le centre): "
     )

     ;; boucle grread
     (while (and (setq gr (grread T 12 0)) loop)
(and star (entdel star) (setq star nil))
(cond

  ;; création dynamique de la polyligne
  ((= 5 (car gr))
   (setq pt   (cadr gr)
	 prj (UcsProject cen)
	 ang  (angle prj pt)
	 dist (distance prj pt)
	 ospt (grosmode pt) ;_ activer l'"accrochage aux objets"
   )
   (if (/= 0 dist)
     (setq star (makestar cen ang dist br ind))
   )
   (grtext -1 (strcat "Rayon: " (rtos dist)))
  )

  ;; Point clic gauche : fin de la boucle
  ((= 3 (car gr))
   (if ospt
     (makestar cen (angle cen ospt) (distance cen ospt) br ind)
     (makestar cen ang dist br ind)
   )
   (setq loop nil)
   (grtext)
  )

  ;; clic droit = boucle sur les différents polygones étoilés
  ((member (car gr) '(12 25))
   (setq ind (+ 2 (rem (- (1+ ind) 2) (1- imax))))
  )

  ;; Entrée = lecture de la ligne de commande
  ((equal gr '(2 13))
   (cond

     ;; distance valide
     ((and str (setq dist (distof str)) (< 0 dist))
      (makestar cen ang dist br ind)
      (setq loop nil)
      (grtext)
     )

     ;; point valide
     ((and str (setq pt (str->pt str)))
      (makestar cen (angle cen pt) (distance cen pt) br ind)
      (setq loop nil)
      (grtext)
     )

     ;; entrée non valide
     (T
      (setq str nil)
      (princ
	"\nPoint ou distance non valide.
	Specifiez le sommet d'un branche (ou la distance depuis le centre): "
      )
     )
   )
  )

  ;; F8 = bascule orthomode
  ((equal gr '(2 15))
   (setvar "ORTHOMODE" (boole 6 1 (getvar "ORTHOMODE")))
   (princ (chr 8))
   (princ (chr 32))
  )

  ;; F3 = bascule osmode
  ((equal gr '(2 6))
   (setvar "OSMODE" (boole 6 16384 (getvar "OSMODE")))
   (princ (chr 8))
   (princ (chr 32))
  )

  ;; afficher et récupérer les entrées à la ligne de commande
  (T
   (if (= (cadr gr) 8) ;_ retour
     (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))))
  )
)
     )

     ;; supprimer le dernier marqueur s'il existe
     (and *GrOsnapMarker*
   (mapcar 'entdel *GrOsnapMarker*)
   (setq *GrOsnapMarker* nil)
     )
   )
   (prompt "\nLe nombre de branches doit être supérieur à 4.")
 )
 (princ)
)

;;;======================== SOUS ROUTINES ========================;;;

;; OrthoRound
;; Retourne l'angle arrondi à pi/2
;;
;; Argument: un angle (radians)

(defun OrthoRound (ang)
 (* (/ pi 2) (fix (/ (+ (/ pi 4) ang) (/ pi 2))))
)

;; STR2PT
;; Convertit une chaîne en point 3d (entrée avec grread)
;;
;; Argument: une chaîne (ex: "25,63")
;; Retour: un point 3d (ex (25.0 63.0 0.0) ou nil si la chaîne n'est pas valide

(defun str2pt (str)
 (setq str (mapcar 'read (str2lst str ",")))
 (if (and (vl-every 'numberp str)
   (< 1 (length str) 4)
     )
   (trans str 0 0)
 )
)

;; STR2LST
;; Convertit une chaîne avec séparateur en liste de chaînes
;;
;; Arguments
;; str = la chaîne
;; sep = le séparateur

(defun str2lst (str sep / pos)
 (if (setq pos (vl-string-search sep str))
   (cons (substr str 1 pos)
  (str2lst (substr str (+ (strlen sep) pos 1)) sep)
   )
   (list str)
 )
)

;; UcsProject
;; Projette un point sur le plan du SCU suivant la vue courante
;;
;; Argument : un point 3d (coordonnées SCU)

(defun UcsProject (pt / pt2 nor org scl)
 (if
   (and (setq pt2 (trans pt 1 2))
 (setq
   pt2 (trans (list (car pt2) (cadr pt2) (1+ (caddr pt2))) 2 0)
 )
 (setq pt (trans pt 1 0))
 (setq nor (trans '(0 0 1) 1 0 T))
 (setq org (getvar "UCSORG"))
 (/= 0
     (setq scl (apply '+ (mapcar '* nor (mapcar '- pt2 pt))))
 )
   )
    (trans
      (mapcar
 (function
   (lambda (x1 x2)
     (+	(* (/ (apply '+ (mapcar '* nor (mapcar '- pt org))) scl)
	   (- x1 x2)
	)
	x1
     )
   )
 )
 pt
 pt2
      )
      0
      1
    )
 )
)

Gilles Chanteau - gileCAD - GitHub
Développements sur mesure pour AutoCAD

Bred Newbie

Bred

Posté(e)
Posté(e)

Salut (gile),

merci pour ces routines.

 

J'ai testé l'étoile, j'ai un bug si je valide au clic droit :

(mon clic droit est paramétrer en validation)

 

Spécifiez le centre de l'étoile:

Specifiez le sommet d'un branche (ou la distance depuis le centre): Erreur:

type d'argument incorrect: fixnump: (3.65249 -3.90891 0.0)

Si vous êtes persuadés de tout savoir sur un sujet, c''est que vous en ignorez quelque chose...

(gile) Proficient

(gile)

Posté(e)
  • Auteur
Posté(e)

Salut,

 

Merci pour le retour.

 

Quand le clic droit est paramétré en validation grread retourne d'abord (11 0) et tout de suite (12 (-915.188 163.762 0.0)) qui est le résultat de la validation.

La routine testait uniquement (member (car gr) '(11 25)), donc le (12 (-915.188 163.762 0.0)) était passé à la condion par défaut : lecture des entrées au clavier, d'où l'erreur.

J'ai remplacé 11 par 12, ça semble fonctionner.

Gilles Chanteau - gileCAD - GitHub
Développements sur mesure pour AutoCAD

  • 3 ans après...

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
 Partager
Aller sur la liste des sujets
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité