alignement de texte

[Invité matmat59]

Bonjour,

 

Connaissez vous un moyen d'aligner du texte sur une entité courbe (type polyligne, arc ou autres...)

 

Merci d'avance!

Matthieu

[lili2006]

Bonjour à toutes et tous,

 

Bienvenue matmat59

 

Si tu as les Express Tools d'installés, tu peux utiliser la fonction " _.arctext"

[Gilles1]

Bonjour.

 

Ci-joint curvetext crée par Lee McDonnell.

Ce lisp (en anglais) aligne du text et/ou mtext sur les courbes quelles qu'elles soient. :cool:

 

;;--------------------=={ CurveText.lsp }==-------------------;;
;;                                                            ;;
;;  Positions Text along a curve object (arc,circle,spline,   ;;
;;  ellipse,line,lwpolyline,polyline), and rotates text to    ;;
;;  fit to the curve accordingly.                             ;;
;;                                                            ;;
;;  If run in versions > AutoCAD2000, the resultant text will ;;
;;  form an anonymous group.                                  ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell                                     ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;                                                            ;;
;;------------------------------------------------------------;;
;;  Version:  1.2   ~¤~   14 June 2010                        ;;
;;------------------------------------------------------------;;

(defun c:CurveText ( / sel str obj )
 ;; © Lee Mac  ~  12.06.10
 (vl-load-com)

 (while
   (progn
     (setq sel (LM:SelectionOrText "\nSpecify or Select Text String: " 2))

     (cond
       (
         (vl-consp sel)

         (if (wcmatch (cdr (assoc 0 (entget (car sel)))) "*TEXT,ATTRIB")
           (not (setq str (cdr (assoc 1 (entget (car sel))))))
           (princ "\n** Object Must be Text or Attribute **")
         )
       )
       (
         (and (eq 'STR (type sel)) (< 0 (strlen sel)))

         (not (setq str sel))
       )
     )
   )
 )
 (if (and str (setq obj (LM:SelectifFoo LM:isCurveObject "\nSelect Curve: ")))
   (LM:CurveText str obj)
 )
 (princ)
)

(defun LM:CurveText ( string Curve / *error* spc doc ObjLst gr code
                                      data pt cPt ang d der dif ts )
 ;; © Lee Mac  ~  12.06.10
 (vl-load-com)

 (defun *error* ( msg )
   (and ObjLst
     (mapcar
       (function
         (lambda ( o )
           (if (and (not (vlax-erased-p o))
                  (vlax-write-enabled-p o))
             (vla-delete o)
           )
         )
       )
       ObjLst
     )
   )
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (or *offset* (setq *offset* 0.0))
 (or *spacin* (setq *spacin* 1.1))

 (setq ts
   (/ (getvar 'textsize)
     (if (LM:isAnnotative (getvar 'textstyle))
       (cond ( (getvar 'cannoscalevalue) ) ( 1.0 )) 1.0
     )
   )
 )

 (setq spc
   (if
     (or
       (eq AcModelSpace
         (vla-get-ActiveSpace
           (setq doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
           )
         )
       )
       (eq :vlax-true (vla-get-MSpace doc))
     )
     (vla-get-ModelSpace doc)
     (vla-get-PaperSpace doc)
   )
 )  

 (setq ObjLst
   (mapcar
     '(lambda ( s / o )
        (vla-put-Alignment
          (setq o
            (vlax-invoke spc 'AddText (chr s)
              (getvar 'viewctr) ts
            )
          )
          acAlignmentMiddleCenter
        )
        o
      )
     (vl-string->list string)
   )
 )

 (setq msg (princ "\n-- Position Text, [+/-] Offset, [>] Spacing --"))
 (while
   (progn
     (setq gr (grread 't 15 0) code (car gr) data (cadr gr))

     (cond
       (
         (and (= 5 code) (listp data))

         (setq cPt (vlax-curve-getClosestPointto Curve (setq pt (trans data 1 0)))
               ang (angle cPt pt)
               d   (vlax-curve-getDistatPoint Curve cPt)
               der (angle '(0. 0. 0.)
                     (vlax-curve-getFirstDeriv Curve
                       (vlax-curve-getParamatPoint Curve cPt)
                     )
                   )
               dif (- ang der)            
         )
         (
           (lambda ( i / p a )
             (mapcar
               (function
                 (lambda ( o )
                   (if
                     (setq p
                       (vlax-curve-getPointatDist Curve
                         (+ d
                           (* (setq i (1+ i)) *spacin* ts)
                         )
                       )
                     )
                     (progn
                       (vla-put-TextAlignmentPoint o
                         (vlax-3D-point
                           (polar p
                             (+
                               (setq a
                                 (angle '(0. 0. 0.)
                                   (vlax-curve-getFirstDeriv Curve
                                     (vlax-curve-getParamatPoint Curve p)
                                   )
                                 )
                               )
                               dif
                             )
                             (* ts *offset*)
                           )
                         )
                       )
                       (vla-put-rotation o (LM:MakeReadable a))
                     )
                   )
                 )
               )
               (if (and (< (/ pi 2.) der) (<= der (/ (* 3. pi) 2.)))
                 (reverse ObjLst) ObjLst
               )
             )
           )
           (- (/ (1+ (strlen string)) 2.))
         )
        t
       )
       ( (member code '(3 25)) nil )
       
       (
         (= 2 code)

         (cond
           ( (member data '(13 32)) nil )

           ( (member data '(43 61))

             (setq *offset* (+ *offset* 0.1))
           )
           ( (member data '(45 95))

             (setq *offset* (- *offset* 0.1))
           )
           ( (member data '(46 62))

             (setq *spacin* (+ *spacin* 0.05))
           )
           ( (member data '(44 60))

             (setq *spacin* (- *spacin* 0.05))
           )
           ( (princ (strcat "\n** Invalid Keypress **" msg)) )
         )
       )
       ( t )
     )
   )        
 )
 (if (< 15. (atof (getvar 'acadver)))
   (vla-AppendItems
     (vla-Add (vla-get-Groups doc) "*") (LM:ObjectVariant ObjLst)
   )
 )
)

(defun LM:MakeReadable ( a )
 ;; © Lee Mac  ~  12.06.10
 (cond
   (
     (and (> a (/ pi 2)) (<= a pi))

     (- a pi)
   )
   (
     (and (> a pi) (<= a (/ (* 3 pi) 2)))

     (+ a pi)
   )
   (
     a
   )
 )
)

(defun LM:isCurveObject ( ent )
 ;; © Lee Mac  ~  12.06.10
 (not
   (vl-catch-all-error-p
     (vl-catch-all-apply
       (function vlax-curve-getEndParam) (list ent)
     )
   )
 )
)

(defun LM:SelectifFoo ( foo str / sel ent )
 ;; © Lee Mac  ~  12.06.10
 (while
   (progn
     (setq sel (entsel str))
     
     (cond
       (
         (vl-consp sel)

         (if (not (foo (setq ent (car sel))))
           (princ "\n** Invalid Object Selected **")
         )
       )
     )
   )
 )
 ent
)

(defun LM:ObjectVariant ( lst )
 ;; © Lee Mac  ~  12.06.10
 (vlax-make-variant
   (vlax-safearray-fill
     (vlax-make-safearray vlax-vbObject
       (cons 0 (1- (length lst)))
     )
     lst
   )
 )
)

(defun LM:Itemp ( coll item )
 ;; © Lee Mac  ~  12.06.10
 (if
   (not
     (vl-catch-all-error-p
       (setq item
         (vl-catch-all-apply
           (function vla-item) (list coll item)
         )
       )
     )
   )
   item
 )
)

(defun LM:isAnnotative ( style / object annotx )
 ;; © Lee Mac  ~  12.06.10
 (and
   (setq object (tblobjname "STYLE" style))
   (setq annotx (cadr (assoc -3 (entget object '("AcadAnnotative")))))
   (= 1 (cdr (assoc 1070 (reverse annotx))))
 )
)

(defun LM:SelectionOrText ( str cur )
 ;; © Lee Mac  ~  12.06.10
 (and str (princ str))
 (
   (lambda ( result / gr code data )  
     (while
       (progn
         (setq gr (grread t 13 cur) code (car gr) data (cadr gr))

         (cond
           (
             (and (= 3 code) (listp data))

             (setq result (nentselp data)) nil
           )
           (
             (= 2 code)

             (cond
               (
                 (<= 32 data 126)

                 (setq result (strcat result (princ (chr data))))
               )
               (
                 (= 13 data) nil
               )
               (
                 (and (= 8 data) (< 0 (strlen result)))

                 (setq result (substr result 1 (1- (strlen result))))
                 (princ (vl-list->string '(8 32 8)))
               )
               (
                 t
               )
             )
           )
           (
             (= 25 code) nil
           )
           (
             t
           )
         )
       )
     )
     result
   )
   ""
 )
)

(princ "\n:: CurveText.lsp © Lee McDonnell 2010 ::")
(princ "\n    -- Type \"CurveText\" to Invoke --  ")
(princ)