résolu Écrire des angles à la volée sur une vue en orientation.

[yann-2]

Bonjour à tous,

Ce programme permet d'écrire des angles à la volée sur une vue en orientation en désignant tout d'abord le centre de la vue (1 seule fois) puis en désignant les différents angles.

Ce programme a été écrit par un Cadxipien dont je ne me rappelle pas le nom, en tous cas, merci à lui.

J'ai tenté de le modifier pour pouvoir écrire en MTEXT plutôt qu'en TEXT, mais je n'y arrive pas.

Merci pour votre aide.

(defun c:y (/ *error* space cen pt ang ht just rot text)
  (vl-load-com)
  (or *acdoc*
      (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
  )
  (defun *error* (msg)
    (and msg
         (/= msg "Fonction annulée")
         (prompt (strcat "\nErreur : " msg))
    )
    (vla-EndUndoMark *acdoc*)
    (princ)
  )
  (if (setq cen (getpoint "\nCentre de la cotation: "))
    (progn
      (vla-StartUndoMark *acdoc*)
      (setq space (vla-get-Block (vla-get-ActiveLayout *acdoc*)))
      (while (setq pt (getpoint cen "\nExtémité de l'angle: "))
        (setq pt (trans pt 1 0)
              cen (trans cen 1 0)
              ang (angle cen pt)
              ht (getvar 'textsize))
        (cond
          ((equal ang (* pi 0.5) 1e-9)
           (setq just acAlignmentBottomCenter
                 rot  0.0
           )
          )
          ((equal ang (* pi 1.5) 1e-9)
           (setq just acAlignmentTopCenter
                 rot  0.0
           )
          )
          ((< (* pi 0.5) ang (* pi 1.5))
           (setq just acAlignmentMiddleRight
                 rot  (+ pi ang)
           )
          )
          (T
           (setq just acAlignmentMiddleLeft
                 rot  ang
           )
          )
        )
        ;;(vla-AddLine space (vlax-3d-point cen) (vlax-3d-point pt))
        (setq text (vla-AddText space (strcat (angtos (- (* 0.5 pi) ang)) "°") (vlax-3d-point pt) ht))
        (vla-put-Rotation text rot)
        (vla-put-Alignment text just)
        (vla-put-TextAlignmentPoint text (vlax-3d-point pt))
      )
    )
  )
  (*error* nil)
)

 

[(gile)]

Salut,

Je pense avoir commis ce LISP.

Pour un texte multiligne à la place d'un texte simple (pourtant beaucoup plus léger) :

(defun c:y (/ *error* space cen pt ang just rot text)
  (vl-load-com)
  (or *acdoc*
      (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
  )
  (defun *error* (msg)
    (and msg
         (/= msg "Fonction annulée")
         (prompt (strcat "\nErreur : " msg))
    )
    (vla-EndUndoMark *acdoc*)
    (princ)
  )
  (if (setq cen (getpoint "\nCentre de la cotation: "))
    (progn
      (vla-StartUndoMark *acdoc*)
      (setq space (vla-get-Block (vla-get-ActiveLayout *acdoc*)))
      (while (setq pt (getpoint cen "\nExtémité de l'angle: "))
        (setq pt (trans pt 1 0)
              cen (trans cen 1 0)
              ang (angle cen pt)
	      )
        (cond
          ((equal ang (* pi 0.5) 1e-9)
           (setq just acAttachmentPointBottomCenter
                 rot  0.0
           )
          )
          ((equal ang (* pi 1.5) 1e-9)
           (setq just acAttachmentPointTopCenter
                 rot  0.0
           )
          )
          ((< (* pi 0.5) ang (* pi 1.5))
           (setq just acAttachmentPointMiddleRight
                 rot  (+ pi ang)
           )
          )
          (T
           (setq just acAttachmentPointMiddleLeft
                 rot  ang
           )
          )
        )
	;;(vla-AddLine space (vlax-3d-point cen) (vlax-3d-point pt))
	(setq text (vla-AddMText space (vlax-3d-point pt) 0.0 (strcat (angtos (- (* 0.5 pi) ang)) "°")))
        (vla-put-Rotation text rot)
        (vla-put-AttachmentPoint text just)
	(vla-put-InsertionPoint text (vlax-3d-point pt))
      )
    )
  )
  (*error* nil)
)

 

[yann-2]

Bonjour (gile),

Merci d'avoir commis le LISP de départ et cette modification.

Juste une question :

Dans la première version

ht (getvar 'textsize))

que l'on ne retrouve pas dans la deuxième version.

Pourtant, lorsque l'on modifie sa hauteur, celle-ci est bien prise en compte ?

 

[(gile)]

La méthode AddText (vla-AddText) requiert la hauteur du texte en argument la méthode AddMText (vla-AddMText) ne requiert pas cet argument, le texte multiligne prend automatiquement la valeur courante (getvar 'textsize).

[yann-2]

OK.

Merci encore et bonne continuation à tous.😉