Texte et Texte Multiligne à hauteur adaptable

[bonuscad]

Bonjour,

 

Un peu pour le "fun" et pour voir si cela serait exploitable, je tente de créer des textes dont la hauteur s’adapterait à l'échelle de la fenêtre papier.

Je sais il y les textes annotatifs qui répondent à ce besoin. Mais je trouve ceux-ci un peu fastidieux à mettre en place et ne fonctionne que pour les échelles déterminées (en plus d'un alourdissement notoire du fichier dessin)

 

Il m'arrive souvent d'établir des sorties qui ne sont pas liées à une échelle, mais plutôt à un format de feuille (donc échelle bidon) et bien sur mes textes ne sont pas adaptés à cette échelle.

 

J'ai donc pensé à utiliser un style de cotation où ceux-ci s'adapteraient à la fenêtre, moyen très souple si l'on reste dans une fourchette d'échelle raisonnable.

 

Le code que j'ai pondu me pose problème; même si la conversion de mes textes et textes multiligne en cotation se passe bien.

C'est lors de l'utilisation de la commande "Mettre à jour" du menu cotation que ça part en "live", je perds le style du texte.

J'ai du faire quelque chose de travers mais je n'arrive pas à voir quoi !!!

 

Si quelqu'un à une idée ?

(defun C:AutoTextScale ( / AcDoc Space js n ent ename txt_height txt_ins txt_rot txt_styl txt_lay txt_col txt_ltyp txt_lweight txt_string txt_sty font_styl dim_sty nw_obj)
 (vl-load-com)
 (setq
   AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
   Space
   (if (= 1 (getvar "CVPORT"))
     (vla-get-PaperSpace AcDoc)
     (vla-get-ModelSpace AcDoc)
   )
 )
 (setq js
   (ssget ;"_X" 
     (list
       (cons 0 "*TEXT")
       (cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
       (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
     )
   )
 )
 (cond
   (js
     (cond
       ((null (tblsearch "DIMSTYLE" "$AutoScaleDim"))
         (setq dim_sty (vla-add (vla-get-dimstyles AcDoc) "$AutoScaleDim"))
       )
       (T (setq dim_sty (vla-item (vla-get-dimstyles AcDoc) "$AutoScaleDim")))
     )
     (vla-put-ActiveDimStyle AcDoc dim_sty)
     (mapcar '(lambda (dimvar value / ) (vla-setvariable AcDoc dimvar Value))
     '("DIMPOST" "DIMAPOST" "DIMSCALE" "DIMASZ" "DIMEXO" "DIMDLI" "DIMEXE" "DIMRND" "DIMDLE" "DIMTP" "DIMTM" "DIMTXT" "DIMCEN" "DIMTSZ" "DIMALTF" "DIMLFAC" "DIMTVP" "DIMTFAC" "DIMGAP" "DIMALTRND" "DIMTOL" "DIMLIM" "DIMTIH" "DIMTOH" "DIMSE1" "DIMSE2" "DIMTAD" "DIMZIN" "DIMALT" "DIMALTD" "DIMTOFL" "DIMSAH" "DIMTIX" "DIMSOXD" "DIMCLRD" "DIMCLRE" "DIMCLRT" "DIMADEC" "DIMDEC" "DIMTDEC" "DIMALTU" "DIMALTTD" "DIMAUNIT" "DIMFRAC" "DIMLUNIT" "DIMDSEP" "DIMTMOVE" "DIMJUST" "DIMSD1" "DIMSD2" "DIMTOLJ" "DIMTZIN" "DIMALTZ" "DIMALTTZ" "DIMUPT" "DIMATFIT")
     '("" "" 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.25 0.0 0.0 25.4 1.0 0.0 1.0 0.0 0.0 0 0 0 0 1 1 0 0 0 2 0 0 1 0 0 0 0 0 4 4 2 2 0 0 2 "." 2 0 1 1 1 0 0 0 0 3)
     )
     (repeat (setq n (sslength js))
       (vla-CopyFrom dim_sty AcDoc)
       (setq
         ename (vlax-ename->vla-object (setq ent (ssname js (setq n (1- n)))))
         txt_height (* 0.01 (vlax-get ename 'Height))
         txt_ins (vlax-get ename 'InsertionPoint)
         txt_rot (vlax-get ename 'Rotation)
         txt_styl (vlax-get ename 'StyleName)
         txt_lay (vlax-get ename 'Layer)
         txt_col (vlax-get ename 'Color)
         txt_ltyp (vlax-get ename 'LineType)
         txt_lweight (vlax-get ename 'Lineweight)
         txt_string (vlax-get ename 'TextString)
       )
       (cond
         ((null (tblsearch "STYLE" (strcat "$AutoScale-" txt_styl)))
           (setq txt_sty (vla-add (vla-get-textstyles AcDoc) (strcat "$AutoScale-" txt_styl)))
           (vlax-for for-item (vla-get-textstyles AcDoc)
             (if (eq (vlax-get for-item 'Name) txt_styl) (setq font_styl (vlax-get for-item 'fontFile)))
           )
           (mapcar
             '(lambda (pr val)
               (vlax-put txt_sty pr val)
             )
             (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
             (list font_styl 0.0 0.0 1.0 0.0)
           )
         )
       )
       (vla-setvariable AcDoc "DIMTXT" txt_height)
       (setq
         nw_obj
         (vla-AddDimOrdinate Space
           (setq pt_dim (vlax-3d-point txt_ins))
           pt_dim
           0
         )
       )
       (vla-put-Layer nw_obj txt_lay)
       (vla-put-Color nw_obj txt_col)
       (vla-put-LineType nw_obj txt_ltyp)
       (vla-put-Lineweight nw_obj txt_lweight)
       (vla-put-AltRoundDistance nw_obj 0.0)
       (vla-put-AltSubUnitsFactor nw_obj 1.0)
       (vla-put-AltSubUnitsSuffix nw_obj "")
       (vla-put-AltSuppressLeadingZeros nw_obj 0)
       (vla-put-AltSuppressTrailingZeros nw_obj 0)
       (vla-put-AltSuppressZeroFeet nw_obj -1)
       (vla-put-AltSuppressZeroInches nw_obj -1)
       (vla-put-AltTextPrefix nw_obj "")
       (vla-put-AltTextSuffix nw_obj "")
       (vla-put-AltTolerancePrecision nw_obj 3)
       (vla-put-AltToleranceSuppressLeadingZeros nw_obj 0)
       (vla-put-AltToleranceSuppressTrailingZeros nw_obj 0)
       (vla-put-AltToleranceSuppressZeroFeet nw_obj -1)
       (vla-put-AltToleranceSuppressZeroInches nw_obj -1)
       (vla-put-AltUnits nw_obj 0)
       (vla-put-AltUnitsFormat nw_obj 2)
       (vla-put-AltUnitsPrecision nw_obj 3)
       (vla-put-AltUnitsScale nw_obj 0.1)
       (vla-put-ArrowheadSize nw_obj 0.0)
       (vla-put-DecimalSeparator nw_obj ".")
       (vla-put-DimTxtDirection nw_obj 0)
       (vla-put-EntityTransparency nw_obj "ByLayer")
       (vla-put-ExtensionLineColor nw_obj 0)
       (vla-put-ExtensionLineOffset nw_obj 0.0)
       (vla-put-ExtensionLineWeight nw_obj -2)
       (vla-put-ExtLineFixedLen nw_obj 0.0)
       (vla-put-ExtLineFixedLenSuppress nw_obj 0)
       (vla-put-FractionFormat nw_obj 0)
       (vla-put-LinearScaleFactor nw_obj 1.0)
       (vla-put-Linetype nw_obj "ByLayer")
       (vla-put-LinetypeScale nw_obj 1.0)
       (vla-put-Lineweight nw_obj -1)
       (vla-put-Material nw_obj "ByLayer")
       ;(vla-put-PlotStyleName nw_obj "ByLayer")
       (vla-put-PrimaryUnitsPrecision nw_obj 2)
       (vla-put-Rotation nw_obj 0.0)
       (vla-put-RoundDistance nw_obj 0.0)
       (vla-put-ScaleFactor nw_obj 1.0)
       (vla-put-StyleName nw_obj "$AutoScaleDim")
       (vla-put-SubUnitsFactor nw_obj 1.0)
       (vla-put-SubUnitsSuffix nw_obj "")
       (vla-put-SuppressLeadingZeros nw_obj 0)
       (vla-put-SuppressTrailingZeros nw_obj 0)
       (vla-put-SuppressZeroFeet nw_obj -1)
       (vla-put-SuppressZeroInches nw_obj -1)
       (vla-put-TextColor nw_obj 0)
       (vla-put-TextFill nw_obj 0)
       (vla-put-TextFillColor nw_obj 0)
       (vla-put-TextGap nw_obj 0.0)
       (vla-put-TextHeight nw_obj txt_height)
       (vla-put-TextMovement nw_obj 2)
       (vla-put-TextOverride nw_obj txt_string)
       (vla-put-TextPosition nw_obj pt_dim)
       (vla-put-TextPrefix nw_obj "")
       (vla-put-TextRotation nw_obj txt_rot)
       (vla-put-TextStyle nw_obj (strcat "$AutoScale-" txt_styl))
       (vla-put-TextSuffix nw_obj "")
       (vla-put-ToleranceDisplay nw_obj 0)
       (vla-put-ToleranceHeightScale nw_obj 1.0)
       (vla-put-ToleranceJustification nw_obj 0)
       (vla-put-ToleranceLowerLimit nw_obj 0.0)
       (vla-put-TolerancePrecision nw_obj 2)
       (vla-put-ToleranceSuppressLeadingZeros nw_obj 0)
       (vla-put-ToleranceSuppressTrailingZeros nw_obj -1)
       (vla-put-ToleranceSuppressZeroFeet nw_obj -1)
       (vla-put-ToleranceSuppressZeroInches nw_obj -1)
       (vla-put-ToleranceUpperLimit nw_obj 0.0)
       (vla-put-UnitsFormat nw_obj 2)
       (vla-put-VerticalTextPosition nw_obj 1)
       (vla-put-Visible nw_obj -1)
       (entdel ent)
     )
   )
 )
 (prin1)
)

 

NB: conçu sous une 2011, pour une 2008 il y a quelques lignes à mettre en rem dans les vla-put concernant les réglages des cotations. (inconnues sous 2008)