SVP 3 Routines sur les Styles de texte

[lecrabe]

Hello les Pros du Lisp

SVP j'aurais besoin d'une routine Lisp "simple" avec 3 fonctionnalités :

---- Routine / Commande 1 : STT_All_SHX

Écraser dans TOUS les Styles de texte du DWG utilisant des polices "xxxxxx.TTF" par la police "ISOCP.SHX"

Ne pas toucher aux Styles existants qui utilisent déjà une quelconque police SHX 

En sortie un REGENALL ... 

---- Routine / Commande 2 : STT_Save

Sauvegarder dans un fichier TXT ou CSV (au même endroit que le DWG) le nom de chaque style de texte + la police utilisée avec le type TTF ou SHX

---- Routine / Commande 3 : STT_Restore

Lire ce fichier TXT ou CSV et mettre à jour le style correspondant trouvé avec la police TTF ou CSV

En sortie un REGENALL ... 

 

##### Utilisation #####

-- Routine 2 "STT_Save" pour sauvegarder les polices des styles de texte

-- Puis Routine 1 "STT_All_SHX" pour tout mettre en ISOCP.SHX

Ainsi le DWG avec beaucoup de texte simple, attribut simple, cotation s'affichera vite et très vite en 3D... Sympa pour travailler le GROS DWG... 

-- Et enfin routine 3 "STT_Restore" pour "rétablir" le DWG original avec les bonnes polices TTF !

 

Voyez vous ce que je veux dire ?

 

Merci d'avance, Bye, lecrabe 

 

 

 

[philsogood]

lecrabe, t'as p^lus le droit aux routines, t'es à la retraite... mtn que t'as le temps tu peux enfin apprendre le langage AutoLisp!! au boulot le retraité!!

Phil

[(gile)]

Salut,

Ça devrait répondre à la demande, mais on pourrait optimiser en faisant la sauvegarde et en modifiant les styles dans la même boucle d'une unique commande STT_All_SHX.

On pourrait aussi enregistrer les anciennes valeurs dans le dessin (xdata, ldata, ...).

Modification : les styles dépendants de xrefs sont écartés :

;; 
;; https://cadxp.com/topic/55909-svp-3-routines-sur-les-styles-de-texte/
;; 
;; Routines: STT_Save___STT_All_SHX___STT_Restore___GC.lsp
;; 
;; Routines ecrites par GC (gile) pour Patrice B.
;; Modification 2022-04-30 les styles dépendants des xrefs sont écartés.
;;

(defun c:STT_Save (/ file ts)
  (setq	file (open (strcat (getvar 'dwgprefix)
			   (vl-filename-base (getvar 'dwgname))
			   "_STT.csv"
		   )
		   "w"
	     )
  )
  (while (setq ts (tblnext "STYLE" (not ts)))
    (if	(zerop (logand (cdr (assoc 70 ts)) 16))
      (write-line
	(strcat (cdr (assoc 2 ts)) ";" (cdr (assoc 3 ts)))
	file
      )
    )
  )
  (close file)
  (princ)
)

(defun setfont (style font / ename elist)
  (and
    (setq ename (tblobjname "STYLE" style))
    (setq elist (entget ename))
    (entmod (subst (cons 3 font) (assoc 3 elist) elist))
  )
)


(defun c:STT_All_SHX (/ ts shx_police) 

(setq shx_police "ISOCP.SHX") 

  (while (setq ts (tblnext "STYLE" (not ts)))
    (if
      (and
	(= (strcase (vl-filename-extension (cdr (assoc 3 ts))))
	   ".TTF"
	)
	(zerop (logand (cdr (assoc 70 ts)) 16))
      )
      (setfont (cdr (assoc 2 ts)) shx_police)
    )
  )
  (command-s "_regenall")
  (princ)
)


(defun c:STT_Restore (/ filename file line style font)
  (and
    (setq
      filename (findfile (strcat (getvar 'dwgprefix)
				 (vl-filename-base (getvar 'dwgname))
				 "_STT.csv"
			 )
	       )
    )
    (setq file (open filename "r"))
    (while (setq line (read-line file))
      (setq pos	  (vl-string-position (ascii ";") line)
	    style (substr line 1 pos)
	    font  (substr line (+ pos 2))
      )
      (if (= (strcase (vl-filename-extension font)) ".TTF")
	(setfont style font)
      )
    )
;;  (command-s "_regenall")
  )
  (command-s "_regenall")
  (princ)
)

 

[lecrabe]

Hello @(gile)

1) MERCI Gilles : c Tip-Top !

Et cela servira beaucoup a ceux qui font de la 3D ou du Covadis par exemple !

2) Par contre sur la routine "STT_Restore", j'ai deplace vers la fin le _REGENALL juste avant le PRINC ...

;;  (command-s "_regenall")
  )
  (command-s "_regenall")
  (princ)
)

La Sante, Bye, lecrabe

 

[lecrabe]

Hello

MERCI a Vincentp010 pour avoir resolu le Bug sur la fonction "STT_All_SHX"

Voici-apres les 3 routines a priori OK pour Moi !

La Sante, Bye, lecrabe

 

 
;; 
;; https://cadxp.com/topic/55909-svp-3-routines-sur-les-styles-de-texte/
;; 
;; Routines: STT_Save___STT_All_SHX___STT_Restore___GC.lsp
;; 
;; Routines ecrites par GC (gile) pour Patrice B. 
;; 
;; --------------------------------------------------------------------------------- 
;; Modification 2022-04-30 vs 1.10 : les styles dependants des XREFs sont ecartes ! 
;; !!!! Version 1.10 corrigee qui traite les XREFs DWG !!!! A priori toujours NOK ! 
;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;; !!!! Vs 1.20 avec la VRAIE correction du Bug sur STT_All_SHX !!!! par vincentp010 
;; https://cadxp.com/topic/56177-visualiser-vite-vos-projets-en-3d/
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;; 

(defun c:STT_Save (/ file ts)
  (setq	file (open (strcat (getvar 'dwgprefix)
			   (vl-filename-base (getvar 'dwgname))
			   "_STT.csv"
		   )
		   "w"
	     )
  )
  (while (setq ts (tblnext "STYLE" (not ts)))
    (if	(zerop (logand (cdr (assoc 70 ts)) 16))
      (write-line
	(strcat (cdr (assoc 2 ts)) ";" (cdr (assoc 3 ts)))
	file
      )
    )
  )
  (close file)
  (princ)
)

(defun setfont (style font / ename elist)
  (and
    (setq ename (tblobjname "STYLE" style))
    (setq elist (entget ename))
    (entmod (subst (cons 3 font) (assoc 3 elist) elist))
  )
)


;;;; "STT_All_SHX" v1.20 de Vincentp010 ;;;; 

(defun c:STT_All_SHX (/ ts shx_police) 

  (setq shx_police "ISOCP.SHX")

  (while (setq ts (tblnext "STYLE" (not ts))) 
    (if (vl-filename-extension (cdr (assoc 3 ts))) 
      (progn 
        (if 
          (= (strcase (vl-filename-extension (cdr (assoc 3 ts)))) 
             ".TTF"
          )
          (setfont (cdr (assoc 2 ts)) shx_police)
        )
      )
    )
  )
  (command-s "_regenall")
  (princ)
)


(defun c:STT_Restore (/ filename file line style font)
  (and
    (setq
      filename (findfile (strcat (getvar 'dwgprefix)
				 (vl-filename-base (getvar 'dwgname))
				 "_STT.csv"
			 )
	       )
    )
    (setq file (open filename "r"))
    (while (setq line (read-line file))
      (setq pos	  (vl-string-position (ascii ";") line)
	    style (substr line 1 pos)
	    font  (substr line (+ pos 2))
      )
      (if (= (strcase (vl-filename-extension font)) ".TTF")
	(setfont style font)
      )
    )
;;  (command-s "_regenall")
  )
  (command-s "_regenall")
  (princ)
)