;; *****************************************************************************
;; Change les styles definis avec une police truetype par une police shx pour accélérer le travail
;; Limitation : Si un fontmap (acad.fmp) est présent qui redirige des shx (compilation de PFB)
;; vers du TTF, vous ne verrez aucun changement.
;; Pour contourner ce pb , placez le fichier joint Null.FMP dans le rep support
;; puis dans preferences, placer fontmap sur null.fmp
;; necessite la police isocp.shx , qui a les même caractéristique que Time ou Arial
;; necessite PowerClic 4.xx installé et chargé (même en Freeware)
;;
;; redefine all TTF or PFB styles with XHX one to make autocad run faster
;; Need isocp.shx  and PowerClic 4.xx installed and running.
;; If a fontmap (acad.fmp) is present and switch pfb or shx to ttf, thi will not work.
;; so copy null.fmp in support directory and declare it as fontmap file.

;; *****************************************************************************
;;§/fonts/change tous les style TTf ou PFB vers SHX/none
;;enregistre la table de correspondance dans un fichier :
;;monchemin/mondessin.fon
;;qui servira au rétablissement.
;
;;Change all TTF styles or PFB to SHX. Save table in a "mydrawing.fon" file.

(defun c:ttf2shx (/ ls le pol f)
  (setq	f (strcat (getvar "dwgprefix")
		  (cadr (pw_scie_fich (getvar "dwgname")))
		  ".fon"
	  )
  )
  (setq f (open f "w"))
  (pw_setvar1 "cmdecho" 0)
  (pw_setvar1 "regenmode" 0)
  (setq ls (pw_list_tabl "STYLE"))
  (foreach l ls
    (setq le (tblsearch "STYLE" l))
    (setq pol (strcase (cdr (assoc 3 le))))
    (if	(or (wcmatch pol "*.TTF") (wcmatch pol "*.PFB"))
      ;;Cherche les style TTF et PFB car PFB sera redirigé vers un TTF
      (progn
	(command "_.style" l "isocp.shx" "" "" "" "" "" "")
					;ecrit la correspondance
	(write-line (strcat l " " pol) f)
      )
    )
  )
  (close f)
  (pw_setvar2 "cmdecho")
  (pw_setvar2 "regenmode")
  (command "_.regen")
)

;; *****************************************************************************
;;§/FONTS/rétablit les polices true type ou pfb/none
;;restore style with original ttf or pfb fonts.
;
(defun c:shx2ttf (/ ls le pol f)
  (setq	f (strcat (getvar "dwgprefix")
		  (cadr (pw_scie_fich (getvar "dwgname")))
		  ".fon"
	  )
  )
  (setq f (open f "r"))
  (pw_setvar1 "cmdecho" 0)
  (pw_setvar1 "regenmode" 0)
  (while (setq l (read-line f))
    (setq l (pw_lst_de_ch l " "))
    (command "_.style" (car l) (cadr l) "" "" "" "" "" "")
  )
  (close f)
  (pw_setvar2 "cmdecho")
  (pw_setvar2 "regenmode")
  (command "_.regen")
)
;;message au chargement
(prompt
 (if pw-foreign
  "\nTo convert TrueType style to SHX, use TTF2SHX command at the prompt."
  "\nPour convertir TrueType en SHX,utilisez la commande TTF2SHX à l'invite Autocad"
 )
)
(prompt
 (if pw-foreign
  "\nTo restore styles from SHX to TrueType, use SHX2TTF command."
  "\nPour retablir SHX en TrueType, utilisez la commande SHX2TTF."
 )
)

;; *****************************************************************************
;;§/fonts/transforme l'arial.ttf en helevetica.shx/none
;
(defun c:helvetica (/ ls le pol f l-style sel  l eg haut width1 )
  (pw_setvar1 "cmdecho" 0)
  (pw_setvar1 "regenmode" 0)
  (setq l-style "")
  (setq ls (pw_list_tabl "STYLE"))
  (foreach l ls
    (setq le (tblsearch "STYLE" l))
    (setq pol (strcase (cdr (assoc 3 le))))
    (if	(= pol "ARIAL.TTF")
      (progn
	(command "_.style" l "helvetica.shx" "" "" "" "" "" "")
	(setq l-style (strcat l "," l-style))
      )
    )
    (if	(= pol "HELVETICA.SHX")
	(setq l-style (strcat l "," l-style))
    )
  )
  (setq sel (ssget "x" (list (cons 7 (strcase l-style 't)))))
 (setq sel (pw_listsel sel))
 (pw_getrealmem "\nFacteur d'echelle fenêtre espace papier ?" "fact-ep")
 (foreach l sel
  (setq eg (entget l))
  (setq haut (cdr (assoc 40 eg)))
  (if (= 1 (cdr (assoc 67 eg))) ;;espace papier
   (setq width1 (* haut 0.075))
   (setq width1 (* haut 0.075 fact-ep))
  )
  (setq width1 (pw_real2indexed (* 100 width1) PW-LWEIGHT100))
  (setq eg (pw_subst_ou_aj 370 width1 eg ))
  (entmod eg)
  (entupd l)
 )
  
  (pw_setvar2 "cmdecho")
  (pw_setvar2 "regenmode")
  (command "_.regen")
)
;; *****************************************************************************
;;§/fonts/transforme l'helevetica.shx en  arial.ttf/none
;
(defun c:arial (/ ls le pol f l-style sel  l eg haut width1 )
  (pw_setvar1 "cmdecho" 0)
  (pw_setvar1 "regenmode" 0)
  (setq l-style "")
  (setq ls (pw_list_tabl "STYLE"))
  (foreach l ls
    (setq le (tblsearch "STYLE" l))
    (setq pol (strcase (cdr (assoc 3 le))))
    (if	(= pol "HELVETICA.SHX")
      (progn
	(command "_.style" l "ARIAL.TTF" "" "" "" "" "" "")
	(setq l-style (strcat l "," l-style))
      )
    )
    (if	(= pol "ARIAL.TTF")
	(setq l-style (strcat l "," l-style))
    )
  )
  (setq sel (ssget "x" (list (cons 7 (strcase l-style 't)))))
 (setq sel (pw_listsel sel))

 (foreach l sel
  (setq eg (entget l))
  (setq eg (pw_subst_ou_aj 370 -3 eg ))
  (setq ch (cdr (assoc 1 eg))) 
  (setq ch (pw_str_subst "" "\\Fhelvetica.shx;" ch))
  (setq eg (pw_subst_ou_aj 1 ch eg ))
  (entmod eg)
  (entupd l)
 )
  
  (pw_setvar2 "cmdecho")
  (pw_setvar2 "regenmode")
  (command "_.regen")
);;
;; G-EAUX le 16/03/2001
;;HTTP://WWW.POWER-CLIC.com
;;Logiciel libre de droit mais fournit sans aucune garantie.


;; *****************************************************************************
;;§/fonts/crée les styles correspondant aux polices shx spécifiées dans un fichier/none
;
(defun c:mk_textstyle (/ ls le pol f)
  (setq	f (getfiled "Fichier liste de polices" "" "txt" 0)
  )
  (setq f (open f "r"))
  (setq pb '(0 0))
  (pw_setvar1 "cmdecho" 0)
  (pw_setvar1 "regenmode" 0)
  (while (setq l (read-line f))
    (setq nstyle (cadr (pw_scie_fich l)))
    (command "_.style" nstyle l "" "" "" "" "" "")
    (command "_Text" pb 2 0 (strcat nstyle " _ - 1 2 3 4 5 6 7 8 9 ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzàéèùç"))
    (setq pb (pw_prp pb 0 -5))
  )
  (close f)
  (pw_setvar2 "cmdecho")
  (pw_setvar2 "regenmode")
  (command "_.regen")
)
;; *****************************************************************************
;;§/fonts/trace tous les carractères possible d'une police sur 3 colonnes/none
;
(defun c:show_cara (/ ls le pol f)
  (setq i 0)
  (setq pb (getpoint "depart ?"))
  (while (< i 259)
    (setq tx (chr i))
    (command "_TEXT" pb 1 0 tx "" )
    (command "_TEXT" (pw_prp pb 5 0) 1 0 (itoa i) "" );;decimal    
;;    (command "_TEXT" (pw_prp pb 5 0) 1 0 (base 16 i) "" ) ;;hexa
     (setq pb (pw_prp pb 0 -1.5))
    (setq i (+ 1 i))
  )
)
  
;; *****************************************************************************
;;§/fonts/trace sur 3 lignes tous les caractére et les codes ascii d'une police/none
;
(defun c:show_font (/ ls le pol f txall)
  (setq i 33)
  (setq pb (getpoint "depart ?"))
  (setq txall "")
  (while (< i 130)
    (setq tx (chr i))
    (setq txall (strcat txall tx))
    (command "_TEXT" pb 2 0 tx "" )
    (command "_TEXT" (pw_prp pb 0 3) 0.6 0 (itoa i) "" )    ;;decimal
;    (command "_TEXT" (pw_prp pb 5 0) 1 0 (base 16 i) "" ) ;;hexa
     (setq pb (pw_prp pb 2 0))
    (setq i (+ 1 i))
  )
  (setq i 161)
  (while (< i 256)
    (setq tx (chr i))
    (setq txall (strcat txall tx))
    (command "_TEXT" pb 2 0 tx "" )
    (command "_TEXT" (pw_prp pb 0 3) 0.6 0 (itoa i) "" )    ;;decimal
;    (command "_TEXT" (pw_prp pb 5 0) 1 0 (base 16 i) "" ) ;;hexa
     (setq pb (pw_prp pb 2 0))
    (setq i (+ 1 i))
  )
  (prompt "\nMaintenant, tracer la chaine complète ")
  (command "_TEXT" pause "" 0 txall "" )
)



;; *****************************************************************************
;;§/fonts/decalage rapide pour polices epaisses/none
(defun c:DKR ()
(while t
(command "_OFFSET" "" pause pause "")
(command "_Chprop" (entlast) "" "_la" "$gg_br"  "")
)
)
(defun c:ajpoly ( / sel p ls lz vmin vmax vc vs zoomed)
 (if (setq sel (entsel "\nSelectionnez polyligne pour ajout sommet"))
  (progn
    (poly_aj_som (car sel) (osnap  (cadr sel) "pro"))
  )
 )
)

;; *****************************************************************************
;;§/fonts/conversion hauteur dessu dessous fichiers shp en fonction du ratio pfb-shx/none
(defun c:fact_shp ()
  (pw_getrealmem "Hauteur consatée ?(pour 2 ht nomin)" "ht2")
  (pw_getintmem "hauter dessous dans fichier shp ? " "htd")
  (setq fact (/ ht2 2.0))
  (print (rtos (* fact 100) 2 0))
  (print (rtos (* fact htd) 2 0))
)
;; *****************************************************************************
;;§/fonts/transforme tous les .ttf en .shx/none
;
(defun c:ttf2shx2 (/ ls le pol f l-style sel  l eg haut width1 )
  
  (pw_setvar1 "cmdecho" 0)
  (pw_setvar1 "regenmode" 0)
  (pw_charger_ini "ttf2shx.ini")
  (setq invfontmap (mapcar '(lambda  (x) (list (cadr x)(car x))) fontmap))
  (setq lnomfont (mapcar 'car invfontmap))  
  ;;traite les styles de texte
  (setq l-style "")
  (setq ls (pw_list_tabl "STYLE"))
  (foreach l ls
    (setq le (tblsearch "STYLE" l))
    (setq pol (strcase (cdr (assoc 3 le))))
    (if	(or (wcmatch pol "*.TTF") (wcmatch pol "*.PFB"))
      (progn
	(setq polshx (strcat (cadr (pw_scie_fich pol)) ".shx"))
	(command "_.style" l polshx "" "" "" "" "" "")
	(setq l-style (strcat l "," l-style))
      )
    )
  )
  ;;traite les MTEXT
  (setq sel (ssget "x" '((0 . "MTEXT"))))
  (setq sel (pw_listsel sel))
  (foreach l sel
   (setq eg (entget l))
   (setq ch (cdr (assoc 1 eg)))
   (setq ltextdesc (pw_extr_textdesc ch))
   (foreach  l ltextdesc
     (if (setq res (pw_decode_po l))
       (progn
	(if (setq filnam (cadr (assoc (car res) invfontmap)));;trouvé une correspondance dans fontmap
	 (setq remplace (strcat "\\F" filnam ))
 	 (setq remplace (strcat "\\F" (pw_space2under (car res)) ".shx"))
;	 (setq remplace (pw_ch_de_lst (cons filnam (cdr res)) "|"))
; 	 (setq remplace (pw_ch_de_lst (cons (strcat (pw_space2under (car res)) ".shx") (cdr res)) "|"))
	)
        (setq ch (pw_str_subst remplace (strcat "\\f" l) ch))
        (setq eg (pw_subst_ou_aj 1 ch eg ))    
	
        )
      )
   )
   (entmod eg)
   (entupd l)
  )
  
  (pw_setvar2 "cmdecho")
  (pw_setvar2 "regenmode")
  (command "_.regen")
)
;; *****************************************************************************
;;§/fonts/extrait les descriptions de police dans un mtext/none
(defun pw_extr_textdesc ( str )
  (setq ldesc (pw_lst_de_ch str "\f"))
  (mapcar '(lambda (x) (car (pw_lst_de_ch x ";"))) ldesc)
)
	
;; *****************************************************************************
;;§/fonts/decode la description de police dans un mtext/none
;;	 \\fArial Narrow|b0|i0|c0|p34;police nor
(defun pw_decode_po ( str / )
;;("{\\" "CityBlueprint|b0|i0|c2|p2" "Juice ITC|b0|i0|c0|p82")
 (if (< 1 (length (setq lst (pw_lst_de_ch str "|"))));;virer les scories
   (progn
     (setq nm (car lst))
     (if (= "b1" (nth 1 lst))
       (setq nm (strcat nm " bold"))
     (if (= "i1" (nth 2 lst))
       (setq nm (strcat nm " italic"))
     )  
    )
     (cons (strcase nm 't) (cdr lst))
   )
   nil
 )
)
;
;; *****************************************************************************
;;§/fonts/transforme le simplexf.shx en simplex.shx/none
;;utile poure les plans edacere
;
(defun c:simplex (/ ls le pol f l-style sel  l eg haut width1 )
  (pw_setvar1 "cmdecho" 0)
  (pw_setvar1 "regenmode" 0)
  (setq l-style "")
  (setq ls (pw_list_tabl "STYLE"))
  (foreach l ls
    (setq le (tblsearch "STYLE" l))
    (setq pol (strcase (cdr (assoc 3 le))))
    (if	(= pol "SIMPLEXF.SHX")
      (progn
	(command "_.style" l "SIMPLEX.SHX" "" "" "" "" "" "")
	(setq l-style (strcat l "," l-style))
      )
    )
    (if	(= pol "SIMPLEXF.SHX")
	(setq l-style (strcat l "," l-style))
    )
  )
  (setq sel (ssget "x" (list (cons 7 (strcase l-style 't)))))
 (setq sel (pw_listsel sel))

 (foreach l sel
  (setq eg (entget l))
  (setq eg (pw_subst_ou_aj 370 -3 eg ))
  (setq ch (cdr (assoc 1 eg))) 
  (setq ch (pw_str_subst "" "\\FSIMPLEX.SHX;" ch))
  (setq eg (pw_subst_ou_aj 1 ch eg ))
  (entmod eg)
  (entupd l)
 )
  
  (pw_setvar2 "cmdecho")
  (pw_setvar2 "regenmode")
  (command "_.regen")
);;