Modification hauteur TEXT avec LISP

[ofabre81]

Bonjour à tous,
Je suis en train d'essayer, pour pouvoir activer la recherche des textes dans un pdf, de modifier mes polices autocad en arial avec un facteur de largeur de 1.
J'ai déjà trouvé le code qui me permet de faire ça mais je voudrais l'adapter pour que lorsque je modifie le facteur de largeur je modifie également la hauteur du texte (en la multipliant par le facteur de largeur original avant de passer celui ci à 1).
le code que j'ai, et qui fonctionne, est le suivant :

Code:

; Première partie du code pour modifier les zone de texte
(setq blocks (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object))))
(vlax-for item blocks
(if (/= "*" (substr (vla-get-Name item) 1 1))
(vlax-for item1 (vla-item blocks (vla-get-Name item))
(if (= "AcDbText" (vla-get-objectname item1))
(vla-put-ScaleFactor item1 1.0)
)
)
)
)
(mapcar '(lambda(x) (vla-put-ScaleFactor (vlax-ename->vla-object x) 1.0))
(vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_X" '((0 . "TEXT")))))))
(vl-cmdf "regen")

; Deuxième partie du code pour modifier les textes dans des blocs
(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "INSERT")(66 . 1))))))
(while (and (setq ent (entnext ent))
(/= (cdr (assoc 0 (entget ent))) "SEQEND"))
(if (= "AcDbAttribute" (vla-get-objectname (setq obj (vlax-ename->vla-object ent))))
(vla-put-ScaleFactor obj 1.0)
)
)
)

J'ai tenté de récupérer la hauteur du texte avec le code suivant intégré mais je n'y arrive pas :

Code:

(setf hauteur (vla-get-Height item1))
(setf factor (vla-get-ScaleFactor item1))
(setf NewHauteur hauteur)
(* NewHauteur factor)
(vla-put-Height item1 NewHauteur)

Merci d'avance pour votre aide.
Bonne journée.

Olivier

[Olivier.R · Accepted solution]

Bonjour ofabre81,

Pour ce mettre au lisp, il faut mieux commencer par des petits lisp que l'on fait de bout en bout.

Donc voici le lisp modifié car ajouter des lettres au petit bonheurs la chance cela ne fonctionne pas.

(setq blocks (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object))))
(vlax-for item blocks
  (if (/= "*" (substr (vla-get-Name item) 1 1))
    (vlax-for item1 (vla-item blocks (vla-get-Name item))
      (if (= "AcDbText" (vla-get-objectname item1))
	(progn (vla-put-Height item1 (* (vla-get-height item1)
					(vla-get-ScaleFactor item1)))
	  (vla-put-ScaleFactor item1 1.0))
	)
      )
    )
  )
(mapcar '(lambda(x)
	   (progn (vla-put-Height (vlax-ename->vla-object x) (* (vla-get-height (vlax-ename->vla-object x))
							 (vla-get-ScaleFactor (vlax-ename->vla-object x))))
	   (vla-put-ScaleFactor (vlax-ename->vla-object x) 1.0)))
	(vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_X" '((0 . "TEXT")))))))
(vl-cmdf "regen")
 

; Deuxième partie du code pour modifier les attributs dans des blocs
(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "INSERT")(66 . 1))))))
  (while (and (setq ent (entnext ent))
	      (/= (cdr (assoc 0 (entget ent))) "SEQEND"))
    (if (= "AcDbAttribute" (vla-get-objectname (setq obj (vlax-ename->vla-object ent))))
      (progn (vla-put-Height obj (* (vla-get-height obj)
							 (vla-get-ScaleFactor obj)))
	(vla-put-ScaleFactor obj 1.0))
      )
    )
  )

Pourrais-tu citer le où les auteurs d'orignines ?

Olivier

[ofabre81]

Bonjour Olivier et merci beaucoup pour ta réponse.
Effectivement j'essaie de faire des petits LISP de bout en bout mais comme je débute ce n'est pas toujours facile.
Là il se trouve que j'avais trouvé précisemment ma problématique à un point près que tu as résolu.
J'avais trouvé ce code sur le forum cadtutor (http://www.cadtutor.net/forum/archive/index.php/t-87371.html?s=895b86fc26f0f6945a8fb6993c3ae8f0) et le code avait été fourni par un certain 7o7.
Encore merci de ton aide.
Bonne journée.

Olivier