Aller au contenu
Problème de lien d'inscription (résolu ?) ×

Publication de plusieurs folios en PDF avec noms de signet automatique...

JPhil

Par JPhil
dans Pour aller plus loin en LISP

 Partager

Messages recommandés

JPhil Collaborator

JPhil

Posté(e)
Posté(e)

A partir d'un carnet de folios, le programme lance la commande publier avec des noms de signet automatique (dont le nom provient d'un texte au niveau cartouche suivi du numéro de folio) après vous avoir demandé où enregistrer votre fichier PDF.

 

Sur un cartouche type A3, je cherche un mtext en haut à droite dans la zone cartouche, en me basant sur le point d'insertion du bloc cartouche mais aussi en tenant compte de son échelle en X  et Y.

Par défaut, dans mon utilisation, le texte est en majuscule avec ou sans accents.

Dans le traitement, alors que le texte est déjà en majuscule, je le rebascule en majuscule afin de supprimer les accents. Ex "FRANCOIS A L'HÔTEL" devient "FRANCOIS A L'HOTEL"

J'applique le programme Nompropre puis j'apporte un traitement sur une partie du texte. Ex "Au Clair De La Lune" devient "Au Clair de la Lune" ou "Francois A L'Hotel" devient "François à l'Hôtel".

Les noms de signet (dans le PDF) seront "Au Clair de la Lune - Folio 1" ; "François à l'Hôtel - Folio 2" et ainsi de suite.

Dans le cas où il n'y a pas de mtext et/ou de bloc cartouche, le nom du signet sera simplement "Folio 3".

Dans le cas où le mtext contient une justification "invisible", le nom du signet va apparaître dans le fichier DSD mais le folio sera absent du PDF.

Dans le cas où il y aurait plusieurs mtext dans la zone cartouche, un seul sera pris en compte. Visible dans le nom du signet à la sortie.

 

Au niveau temps pour un fichier qui contient environ 40 folios, il faut compter un peu moins de 4 minutes pour la création du fichier d'impression (temppub.dsd) puis moins de 3 minutes pour obtenir le PDF finalisé.

  

(defun LSTPUB ()
(progn
(vl-load-com)

;;; Verrouiller toutes les fenêtres des présentations
(setq doc (vla-get-activedocument (vlax-get-acad-object))
	n 0
  ) ; fin setq
  (vla-startundomark doc)
  (if (ssget "_x" (list (cons 0 "VIEWPORT")))
    (progn
      (vlax-for ent (setq sel (vla-get-activeselectionset doc))
	(and (eq (vla-get-displaylocked ent) :vlax-false)
	     (setq n (1+ n))
	     (vla-put-displaylocked ent :vlax-true)
        ) ; fin and
      ) ; fin vlax
      (vla-delete sel)
    ) ; fin progn
  ) ; fin if
  (vla-endundomark doc)
  (princ)

;;; Fin de verrouillage des fenêtres des présentations


(setq lstf nil)
(setq lstlay nil)
(setq pdgname "PDG") ; voir lisp "GEFPAGING"
(setq pdg 0)


;;; Listing de tous les onglets or "Model" et pdgname
(vlax-for layout (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
   (if (/= (vla-get-name layout) "Model")
      (progn
         (if (= (vla-get-name layout) pdgname)
            (setq pdg 1)
         ) ; fin if
         (if (/= (vla-get-name layout) pdgname)
            (setq lstlay (vl-list* (vla-get-name layout) lstlay))
         ) ; fin if
      ) ; fin progn
   ) ; fin if layout "Model"
) ; fin vlax
;;; Fin listing de tous les onglets or "Model" et pdgname

;;; Test longueur des noms d'onglets
(setq strlenmin 1000)
(setq strlenmax 0)
(setq strlenopt 1)
(foreach x lstlay
   (if (< (strlen x) strlenmin)
      (setq strlenmin (strlen x))
   ) ; fin if
   (if (> (strlen x) strlenmax)
      (setq strlenmax (strlen x))
   ) ; fin if
) ; fin foreach
(if (= strlenmin strlenmax)
   (progn
      (setq strlenopt 0)
      (setq lstlaytmp lstlay)
   ) ; fin progn
) ; fin if
;;; Fin test longueur des noms d'onglets

;;; Rajout 0
(if (= strlenopt 1)
   (progn
      (setq xpre nil)
      (setq xsuf nil)
      (setq x1 nil)
      (setq lstlaytmp nil)
      (foreach x lstlay
         (if (= (strlen x) strlenmin)
            (progn
               (setq xpre (substr x 1 (- (strlen x) (- strlenmax strlenmin))))
               (setq xsuf (substr x (+ 1 (- (strlen x) (- strlenmax strlenmin)))))
               (setq x1 (strcat xpre "0" xsuf))
            ) ; fin progn
         ) ; fin if
         (if (= (strlen x) strlenmax)
            (setq x1 x)
         ) ; fin if
         (setq lstlaytmp (vl-list* x1 lstlaytmp))
      ) ; fin foreach
   ) ; fin progn if strlenopt 
) ; fin if strlenopt 
;;; Fin de rajout 0

;;; Tri en ordre croissant
(setq lstlay (vl-sort lstlaytmp '<))
;;; Fin tri en ordre croissant

;;; Suppression du 0
(if (= strlenopt 1)
   (progn
      (setq xpre nil)
      (setq xsuf nil)
      (setq x1 nil)
      (setq lstlaytmp nil)
      (foreach x lstlay
         (if (= (substr x (- (strlen x) (- strlenmax strlenmin)) 1) "0")
            (progn
               (setq xpre (substr x 1 (- (strlen x) (+ (- strlenmax strlenmin) 1))))
               (setq xsuf (substr x (+ 1 (- (strlen x) (- strlenmax strlenmin)))))
               (setq x1 (strcat xpre xsuf))
            ) ; fin progn
         ) ; fin if
         (if (/= (substr x (- (strlen x) (- strlenmax strlenmin)) 1) "0")
            (setq x1 x)
         ) ; fin if
         (setq lstlaytmp (vl-list* x1 lstlaytmp))
      ) ; fin foreach lstlay
   ) ; fin progn if strlenopt 
) ; fin if strlenopt 
(setq lstlay lstlaytmp)
;;; Fin de suppression du 0

(setq lstlay (reverse lstlay))

;;; Ajout PDG
(if (= pdg 1)
   (setq lstlay (cons pdgname  lstlay))
) ; fin if
;;; Fin ajout PDG

;;; Liste Layout Name
(setq lstlayoutname nil)
(setq lstlayoutname (reverse lstlay))
(princ)
;;; Fin de liste Layout Name

;;; traitement
(foreach folioname lstlay
   (progn
      (command "ctab" folioname) ; nom de la présentation
      (command "_pspace") ; Mode espace papier
      (command "_.zoom" "_extents") ; Zoom

      ;;; Recherche du bloc cartouche
      (setq nombloc "Cartouche horizontal")
      (setq ss (ssget "x" (list '(0 . "INSERT") (cons 2 nombloc) (cons 410 folioname))))
      (if ss ; test si nombloc est présent
         (progn
            (setq bloc (ssname ss 0))
            ;;; Récupère info position et échelle du cartouche
            (setq positionX (getpropertyvalue bloc "Position/X"))
            (setq positionY (getpropertyvalue bloc "Position/Y"))
            (setq scaleX (getpropertyvalue bloc "ScaleFactors/X"))
            (setq scaleY (getpropertyvalue bloc "ScaleFactors/Y"))
            ;;; Points du cadre de recherche du texte
            (setq ptX1 105) ; point X en bas à gauche zone cartouche à capturer en 0,0,0
            (setq ptX2 204.5) ; point X en haut à droite zone cartouche à capturer en 0,0,0
            (setq ptY1 8) ; point Y en bas à gauche zone cartouche à capturer en 0,0,0
            (setq ptY2 24) ; point Y en haut à droite zone cartouche à capturer en 0,0,0
            ;;; Ajustement des points de recherche par rapport au bloc acrtouche
            (setq txtpositionX1 (+ (* ptX1 scaleX) positionX))
            (setq txtpositionX2 (+ (* ptX2 scaleX) positionX))
            (setq txtpositionY1 (+ (* ptY1 scaleY) positionY))
            (setq txtpositionY2 (+ (* ptY2 scaleY) positionY))
            (setq e (list txtpositionX1 txtpositionY1))
            (setq d (list txtpositionX2 txtpositionY2))
            ;;; Capture du texte
            (setq jsel (ssget "_C" e d '((0 . "*TEXT"))))
               ;;; quand ssget est vide
               (if jsel ; test si sélection est non vide
                  (setq folioinfo (cdr (assoc 1 (entget (ssname jsel 0)))))
                  (setq folioinfo "Xxxx") ; si mtext non présent mettre "Xxxx"
               ) ; fin if jsel
         ) ; fin progn if ss
         (setq folioinfo "Xxxx") ; si bloc cartouche non présent mettre "Xxxx"
      ) ; fin if ss

;;; ***************************************
;;; Début du traitement du contenu du texte
;;; ***************************************

;;; Suppression du format mtext
(if (vl-string-search "\pxq" folioinfo)
   (Progn
      (setq pos (vl-string-search "\pxq" folioinfo))
      (setq tempstr (substr folioinfo (1+ pos) 5))
      (setq folioinfo (vl-string-subst "" tempstr folioinfo pos))
      (setq folioinfo (vl-string-subst "" "\\" folioinfo))
   ) ; fin du progn pxq
) ; fin du if pxq
;;; Fin de suppression du format mtext

;;; Remplacement des caractères
(if (wcmatch folioinfo "*\\P*")
   (while (wcmatch folioinfo "*\\P*")
      (setq folioinfo (vl-string-subst " - " "\\P" folioinfo))
   )
)
(if (wcmatch folioinfo "*/*")
   (while (wcmatch folioinfo "*/*")
      (setq folioinfo (vl-string-subst "-" "/" folioinfo))
   )
)
(if (wcmatch folioinfo "*  *")
   (while  (wcmatch folioinfo "*  *")
      (setq folioinfo (vl-string-subst " " "  " folioinfo))
   )
)
(if (wcmatch folioinfo "*- -*")
   (while (wcmatch folioinfo "*- -*")
      (setq folioinfo (vl-string-subst "-" "- -" folioinfo))
   )
)
(if (wcmatch folioinfo "*--*")
   (while (wcmatch folioinfo "*--*")
      (setq folioinfo (vl-string-subst "-" "--" folioinfo))
   )
)
(if (wcmatch folioinfo "*- (*")
   (while (wcmatch folioinfo "*- (*")
      (setq folioinfo (vl-string-subst "(" "- (" folioinfo))
   )
)
(if (wcmatch folioinfo "*) -*")
   (while (wcmatch folioinfo "*) -*")
      (setq folioinfo (vl-string-subst ")" ") -" folioinfo))
   )
)
(if (or (= (substr folioinfo 1 1) " ") (= (substr folioinfo 1 1) "-"))
   (while (or (= (substr folioinfo 1 1) " ") (= (substr folioinfo 1 1) "-"))
      (setq folioinfo (substr folioinfo 2))
   )
)
(if (or (= (substr folioinfo (strlen folioinfo) 1) " ") (= (substr folioinfo (strlen folioinfo) 1) "-"))
   (while (or (= (substr folioinfo (strlen folioinfo) 1) " ") (= (substr folioinfo (strlen folioinfo) 1) "-"))
      (setq folioinfo (substr folioinfo 1 (- (strlen folioinfo) 1)))
   )
)
;;; Fin de remplacement des caractères

;;; Passage en NomPropre
(setq folioinfo (strcase folioinfo))
(setq folioinfo (Nompropre folioinfo))
;;; Fin de passage en NomPropre

;;; Remplacement des caractères de/des/du/le/la/les/d'/l'/et
(if (wcmatch folioinfo "* De *")
   (while (wcmatch folioinfo "* De *")
      (setq folioinfo (vl-string-subst " de " " De " folioinfo))
   )
)
(if (wcmatch folioinfo "*-De-*")
   (while (wcmatch folioinfo "*-De-*")
      (setq folioinfo (vl-string-subst "-de-" "-De-" folioinfo))
   )
)
(if (wcmatch folioinfo "* Des *")
   (while (wcmatch folioinfo "* Des *")
      (setq folioinfo (vl-string-subst " des " " Des " folioinfo))
   )
)
(if (wcmatch folioinfo "*-Des-*")
   (while (wcmatch folioinfo "*-Des-*")
      (setq folioinfo (vl-string-subst "-des-" "-Des-" folioinfo))
   )
)
(if (wcmatch folioinfo "* Du *")
   (while (wcmatch folioinfo "* Du *")
      (setq folioinfo (vl-string-subst " du " " Du " folioinfo))
   )
)
(if (wcmatch folioinfo "*-Du-*")
   (while (wcmatch folioinfo "*-Du-*")
      (setq folioinfo (vl-string-subst "-du-" "-Du-" folioinfo))
   )
)
(if (wcmatch folioinfo "* Le *")
   (while (wcmatch folioinfo "* Le *")
      (setq folioinfo (vl-string-subst " le " " Le " folioinfo))
   )
)
(if (wcmatch folioinfo "*-Le-*")
   (while (wcmatch folioinfo "*-Le-*")
      (setq folioinfo (vl-string-subst "-le-" "-Le-" folioinfo))
   )
)
(if (wcmatch folioinfo "* Les *")
   (while (wcmatch folioinfo "* Les *")
      (setq folioinfo (vl-string-subst " les " " Les " folioinfo))
   )
)
(if (wcmatch folioinfo "*-Les-*")
   (while (wcmatch folioinfo "*-Les-*")
      (setq folioinfo (vl-string-subst "-les-" "-Les-" folioinfo))
   )
)
(if (wcmatch folioinfo "* La *")
   (while (wcmatch folioinfo "* La *")
      (setq folioinfo (vl-string-subst " la " " La " folioinfo))
   )
)
(if (wcmatch folioinfo "*-La-*")
   (while (wcmatch folioinfo "*-La-*")
      (setq folioinfo (vl-string-subst "-la-" "-La-" folioinfo))
   )
)
(if (wcmatch folioinfo "*D'*")
   (while (wcmatch folioinfo "*D'*")
      (setq folioinfo (vl-string-subst "d'" "D'" folioinfo))
   )
)
(if (wcmatch folioinfo "*L'*")
   (while (wcmatch folioinfo "*L'*")
      (setq folioinfo (vl-string-subst "l'" "L'" folioinfo))
   )
)
(if (wcmatch folioinfo "* Et *")
   (while (wcmatch folioinfo "* Et *")
      (setq folioinfo (vl-string-subst " et " " Et " folioinfo))
   )
)
(if (wcmatch folioinfo "*-Et-*")
   (while (wcmatch folioinfo "*-Et-*")
      (setq folioinfo (vl-string-subst "-et-" "-Et-" folioinfo))
   )
)
;;; Fin remplacement des caractères de/des/du/le/la/les/d'/l'/et

;;; Remplacement des caractères accentués
(if (wcmatch folioinfo "* A *")
   (while (wcmatch folioinfo "* A *")
      (setq folioinfo (vl-string-subst " à " " A " folioinfo))
   )
)
(if (wcmatch folioinfo "*-A-*")
   (while (wcmatch folioinfo "*-A-*")
      (setq folioinfo (vl-string-subst "-à-" "-A-" folioinfo))
   )
)
(if (wcmatch folioinfo "*Legende*")
   (while (wcmatch folioinfo "*Legende*")
      (setq folioinfo (vl-string-subst "Légende" "Legende" folioinfo))
   )
)
(if (wcmatch folioinfo "*Arriere*")
   (while (wcmatch folioinfo "*Arriere*")
      (setq folioinfo (vl-string-subst "Arrière" "Arriere" folioinfo))
   )
)

;;; Exemple avec certains mots

(if (wcmatch folioinfo "*Francois*")
   (while (wcmatch folioinfo "*Francois*")
      (setq folioinfo (vl-string-subst "François" "Francois" folioinfo))
   )
)
(if (wcmatch folioinfo "*Hotel*")
   (while (wcmatch folioinfo "*Hotel*")
      (setq folioinfo (vl-string-subst "Hôtel" "Hotel" folioinfo))
   )
)
(if (wcmatch folioinfo "*Musee*")
   (while (wcmatch folioinfo "*Musee*")
      (setq folioinfo (vl-string-subst "Musée" "Musee" folioinfo))
   )
)

;;; Fin remplacement des caractères accentués


;;; Ajout du nom de folio
(if (vl-string-position (ascii "-") folioname)
   (setq folioname (substr folioname 1 (vl-string-position (ascii "-") folioname)))
) ; Fin du if ascii "-"
(setq folioname (vl-string-subst "olio" "olio " folioname))
(setq folioname (vl-string-subst "olio " "olio" folioname))


(if (wcmatch folioname "* 0*")
   (while (wcmatch folioname "* 0*")
      (setq folioname (vl-string-subst " " " 0" folioname))
   )
)

(if (= folioinfo "Xxxx") ; "Xxxx" si mtext et/ou bloc cartouche non présent prendre uniquement le nom du folio
   (setq folioinfo folioname)
   (setq folioinfo (strcat folioinfo " - " folioname))
)

;;; Fin d'ajout du nom de folio

;;; *************************************
;;; Fin du traitement du contenu du texte
;;; *************************************

(setq lstf (cons folioinfo lstf))
(princ)

) ; fin progn
) ; fin foreach folioname lstlay

;;; Liste Sheet Name
(setq lstsheetname nil)
(setq lstsheetname lstf)
(princ)
;;; Fin de liste Sheet Name

;;; *********************
;;; Traitement pour D-S-D
;;; *********************

;;; nth 0 = folio 1
(setq lst nil)
(setq nbtab nil)
(setq nbtab0 0)
(setq dwgname nil)
(setq pagesetup nil)
(setq nbtab (- (length (layoutlist)) 1))
(setq dwgname (strcat (getvar "DWGPREFIX") (getvar "DWGNAME")))
(setq pagesetup "")
(while (<= nbtab0 nbtab)
   (setq lstsheetname0 (nth nbtab0 lstsheetname))
   (setq lstlayoutname0 (nth nbtab0 lstlayoutname))
   (setq lst0 (list lstsheetname0 dwgname lstlayoutname0 pagesetup dwgname))
   (setq lst (cons lst0 lst))
   (setq nbtab0 (+ nbtab0 1))
) ; fin while
(setq typ nil)
(setq typ 6)
(setq dwf nil)
(setq dwf (strcat PubPath (substr (getvar "DWGNAME") 1 (- (strlen (getvar "DWGNAME")) 4)) ".pdf"))
(setq out nil)
(setq out (strcat (getvar "DWGPREFIX")))
(setq vf nil)
(setq vf "TRUE")

;;; ****************************
;;; Fin de traitement pour D-S-D
;;; ****************************

) ; fin progn
) ; fin defun

;;===========================================================================;;
;; MKDSD IS A UTILITY WHICH WILL CONSTRUCT A DRAWING SET DESCRIPTION FILE    ;;
;; (*.DSD) FOR CONFIGURATION OF THE "PUBLISH" COMMAND                        ;;
;;                                                                           ;;
;; ARGUMENTS: LST -> A LIST - OR LIST OF LISTS - COMPRISED OF:               ;;
;;                   1) SHEET NAME (STR); USUALLY THE NAME OF THE DRAWING    ;;
;;                   2) FULL DRAWING PATH (STR), INCLUDING FILE NAME         ;;
;;                   3) LAYOUT NAME (STR)                                    ;;
;;                   4) PAGE SETUP (STR); NOTE - EMPTY STRING IF PAPERSPACE  ;;
;;                   5) SHEET PATH (STR); TYPICALLY THE SAME AS DRAWING PATH ;;
;;            TYP -> AN INTEGER, INDICATING THE TYPE OF OUTPUT:              ;;
;;                   0 - DWF, SINGLE SHEETS                                  ;;
;;                   1 - DWF, MULTI-SHEET                                    ;;
;;                   2 - PRINTER SPECIFIED IN PAGE SETUP                     ;;
;;                   3 - DWFX, SINGLE SHEETS                                 ;;
;;                   4 - DWFX, MULTI-SHEET                                   ;;
;;                   5 - PDF, SINGLE SHEET                                   ;;
;;                   6 - PDF, MULTI-SHEET                                    ;;
;;            DWF -> OUTPUT (STR) - FULL PATH/NAME FOR MULTI-SHEET FILE      ;;
;;            OUT -> OUTPUT (STR) - PATH ONLY FOR SINGLE SHEET FILES         ;;
;;                                  (NAMES TAKEN FROM INDIVIDUAL SHEET       ;;
;;                                  NAMES, PER LST ARGUMENT, ABOVE)          ;;
;;            VF  -> BOOLEAN - INDICATES WHETHER TO OPEN GENERATED FILE      ;;
;;===========================================================================;;

(defun mkdsd (lst typ dwf out vf / D-S-D FIL FLDSD I S X Y)
  (setq d-s-d (open (setq fil (strcat PubPath "temppub.dsd")) "w"))
  (setq filp fil)

  ; FLDSD CONSTRUCTS STRINGS BASED ON THE LST ARGUMENT,
  ; TO BE WRITTEN INTO THE DSD.
  
  (defun fldsd (strlst / )
    (mapcar '(lambda (s) (write-line s d-s-d))
	    (append
	      (mapcar '(lambda (x y) (vl-string-subst x "\|/" y))
		      strlst
		      (list "[DWF6Sheet:\|/]"
			    "DWG=\|/"
			    "Layout=\|/"
			    "Setup=\|/"
			    "OriginalSheetPath=\|/"
			    ); list
		      ); mapcar
	      (list "Has Plot Port=0" "Has3DDWF=0")
	      ); append
	    ); mapcar
    ); fin defun fldsd
  (mapcar '(lambda (i) (write-line i d-s-d))
	  (list "[DWF6Version]"
		"Ver=1"
		"[DWF6MinorVersion]"
		"MinorVer=1"
		); list
	  ); mapcar
  (if (listp (car lst))
    (mapcar 'fldsd lst)
    (fldsd lst)
    ); if
  (mapcar '(lambda (i) (write-line i d-s-d))
	  (list "[Target]"
		(strcat "Type=" (itoa typ))
		(strcat "DWF=" dwf)
		(strcat "OUT=" out)
		"PWD="
		"[MRU block template]"
		"MRU=0"
		"[MRU Local]"
		"MRU=0"
		"[MRU Sheet List]"
		"MRU=0"
		"[AutoCAD Block Data]"
		"IncludeBlockInfo=0"
		"BlockTmplFilePath="
		"[SheetSet Properties]"
		"IsSheetSet=FALSE"
		"IsHomogeneous=FALSE"
		"SheetSet Name="
		"NoOfCopies=1"
		"PlotStampOn=FALSE"
		(strcat "ViewFile=" (if vf "TRUE" "FALSE"))
		"JobID=0"
		"SelectionSetName="
		(strcat "AcadProfile=" (getvar "cprofile"))
		"CategoryName="
		"LogFilePath="
		"IncludeLayer=FALSE"
		"LineMerge=FALSE"
		"CurrentPrecision="
		"PromptForDwfName=FALSE"
		"PwdProtectPublishedDWF=FALSE"
		"PromptForPwd=FALSE"
		"RepublishingMarkups=FALSE"
		"PublishSheetSetMetadata=FALSE"
		"PublishSheetMetadata=FALSE"
		"3DDWFOptions=0 1"
		); list
	  ); mapcar
  (close d-s-d)
  fil
  ); fin defun mkdsd

(defun Nompropre (str / lst flag)
 (apply 'strcat
        (mapcar '(lambda (x)
                   (setq x    (strcase (substr str 1 1) flag)
                         str  (substr str 2)
                         flag (not (wcmatch x "`-, ,'"))
                   )
                   x
                 )
                (repeat (strlen str) (setq lst (cons T lst)))
        )
 )
) ; fin defun Nompropre

(defun GETDIR( / cdl rep)
 (setq cdl (vlax-create-object "Shell.Application")
       rep (vlax-invoke cdl 'browseforfolder 0 "Sélectionnez la branche de répertoires à traiter" 512 ""))
 (vlax-release-object cdl)
 (setq PubPath (strcat (vlax-get-property (vlax-get-property rep 'self) 'path) "\\"))
) ; fin defun GETDIR


(defun c:GEFPUB()
(progn
(GETDIR)
(LSTPUB)
(mkdsd lst typ dwf out vf)
;;; sauvegarde état boite de dialogue
(setq oldFD (getvar "FILEDIA"))
;;; boite de dialogue désactivée
(setvar "FILEDIA" 0)
;;; publication avec le fichier dsd
(command "-publish" filp)
;;; restauration boite de dialogue
(setvar "FILEDIA" oldFD)
) ; fin progn GEFPUB
) ; fin defun GEFPUB

 

Remarques :

- J'hésite à supprimer le fichier DSD à la fin. Bonne ou mauvaise idée ?

- Est-il possible de supprimer toutes les justifications étranges d'un mtext ? 

- J'ai tenté de jouer sur la longueur des noms de présentations. Ex "Folio 1" avec "Folio 10" qui fonctionne plutôt bien, mais ne fonctionne plus si on a "Folio1-10" avec "Folio10-10" ou "Folio 1" avec "Folio 100"

J'ai pas insisté et j'ai fait au plus simple avec le programme "GEFPAGING" disponible >>> ici <<<

Rappel du programme "GEFPAGING"

Citation 

;; Renumber Layouts  -  Lee Mac
;; Sequentially numbers all Paperspace layouts, with an optional prefix & suffix.
;; Optional Page de Garde include

(defun RL ( / int lst lyn ord pre sed suf )

    ;; Ask for a Page de Garde
    (initget "Yes No")
    (setq pdgtab 0)
    (if
      (= (getkword "\nY'a t'il une Page de Garde ? [Yes/No] <No>: ") "Yes")
      (setq pdgtab -1)
    )
    (initget "Yes No")
    (setq savezeros 0)
    (if
      (= (getkword "\nFaire apparaitre des 0 du style 001/100 ? [Yes/No] <No>: ") "Yes")
      (setq savezeros -1)
    )


    (setq padzeros nil)

    ;; Count all tabs with or without Page de Garde
    (setq nbtab (itoa (+ pdgtab (length (layoutlist)))))

    ;; Prefix & suffix
    (setq pdgname "PDG"
          pre "Folio"
          suf (strcat "-" nbtab)
          lyn (list (strcase pre))
    )

    ;; Obtain list of layout objects, current names, and sort index
    (vlax-for lyt (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
        (if (= :vlax-false (vla-get-modeltype lyt))
            (setq lst (cons lyt lst)
                  lyn (cons (strcase (vla-get-name lyt)) lyn)
                  ord (cons (vla-get-taborder lyt) ord)
            )
        )
    )

    ;; Construct a unique seed for temporary renaming
    (setq sed "%")
    (while (vl-some '(lambda ( x ) (wcmatch x (strcat "*" sed "*"))) lyn)
        (setq sed (strcat sed "%"))
    )

    ;; Temporarily rename layouts to ensure no duplicate keys when renumbering
    (setq int (+ 0 pdgtab))
    (foreach lyt lst
        (vla-put-name lyt (strcat sed (itoa (setq int (1+ int)))))
    )

    ;; Rename layouts in tab order, with prefix & suffix
    (setq int (+ 0 pdgtab))
    (foreach idx (vl-sort-i ord '<)
       (progn
       (setq int (1+ int))
       (setq padzeros (itoa int))
       (while (< (strlen padzeros) (strlen nbtab))
       (setq padzeros (strcat "0" padzeros))
       )
        (vla-put-name (nth idx lst) (strcat pre padzeros suf))

    ;; Rename the first layout PDG if the answer of Page de Garde is Yes
        (if (= int 0)
        (vla-put-name (nth idx lst) pdgname)
        )
       )
    )
    (princ)
)


(defun PAGING( / nombloc attpage attnumpage adoc numtabs atts id lay_field)
(progn
; Paramètres

   (setq nombloc "Cartouche horizontal")  ; nom du bloc cartouche
   (setq attpage "NUM_F")                   ; étiquette de l'attribut numéro de page
   (setq lstlay nil)
; Fin paramètres

   (vlax-for layout (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
      (if (/= (vla-get-name layout) "Model")
         (setq lstlay (vl-list* (vla-get-name layout) lstlay))
      )
   )
   (foreach folioname lstlay
      (progn
         (command "ctab" folioname)
         ;;; Mode espace papier
         (command "_pspace")
         ;;; Zoom
         (command "_.zoom" "_extents")
         (setq ss (ssget "x" (list '(0 . "INSERT") (cons 2 nombloc) (cons 410 folioname))))
(if ss
(progn
         (setq x (sslength ss))
         (foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS (setq x (- x 1)) )) 'getattributes)
            (if (= attpage (strcase (vla-get-tagstring att)))
               (progn
                  (setq folionamenew folioname)
                  (if (wcmatch folionamenew "*olio*")
                     (setq folionamenew (vl-string-subst "OLIO " "olio" folionamenew))
                  )
                  (if (= savezeros 0)
                     (if (wcmatch folionamenew "* 0*")
                     (while (wcmatch folionamenew "* 0*")
                        (setq folionamenew (vl-string-subst " " " 0" folionamenew))
                     )
                     )
                  )
                  (if (wcmatch folionamenew "*-*")
                     (setq folionamenew (vl-string-subst "/" "-" folionamenew))
                  )
                  (vla-put-textstring att folionamenew) 
               )
            ) ; end if
         ) ; foreach
) ; fin progn if ss
) ; fin if ss
      ) ; progn
   ) ; foreach folioname lstlay
   (princ)
)
) ; fin defun PAGING



(defun c:GEFPAGING()
(vl-load-com) (princ)
(RL)
(PAGING)
)

 

 

En attente de vos remarques et/ou optimisations 🙂

Luna Experienced

Luna

Posté(e)
Posté(e) (modifié)

Coucou,

Pour commencer, bravo pour ce programme ! :3 Ensuite, pour répondre à tes questions :

Citation

- J'hésite à supprimer le fichier DSD à la fin. Bonne ou mauvaise idée ?

Tout dépends de comment tu souhaites utiliser tes fichiers par la suite. Si par exemple tu modifies tes folios (et donc les ré-imprimer), je suppose qu'il est possible d'utiliser le fichier .dsd créer précédemment pour relancer l'impression ? Si toutefois, il te paraît plus simple de publier les folios qu'avec ta commande, alors il serait préférable de le supprimer à la fin étant donné que ton programme va le re-créer de toute manière 🙂

Citation

- Est-il possible de supprimer toutes les justifications étranges d'un mtext ?

Qu'entends-tu par "justifications étranges" ? Le fait que le texte soit aligné à gauche, au centre, à droite ou justifié ? Si c'est uniquement cela, il me semble que les propriétés de justification d'un MText sont définies par la chaîne "\\pxq[];" avec "[]" pouvant avoir pour valeur "l" (= left), "c" (= center), "r" (= right) ou "j" (= justify). Donc en supprimant ces chaînes cela devrait régler le soucis. Autrement il y a le programme de @GEGEMATIC issu du programme STRIPMTEXT dans ce post.

Autrement, je pense que la partie "; Passage en nom propre" et "Remplacement des caractères" possède une écriture très répétitive qui pourrait se simplifier en créant une fonction. Mais c'est uniquement de la simplification d'écriture donc non nécessaire en soit, juste des économies de lignes et une généralisation possible :3

Bisous,
Luna

Modifié par Luna
Ajout du lien STRIPMTEXT
JPhil Collaborator

JPhil

Posté(e)
  • Auteur
Posté(e)

Merci Luna 😊
Si ça peut donner des idées à certains, alors tant mieux.


Laisser le fichier DSD peut permettre de comprendre pourquoi un ou plusieurs folios et/ou signets ne sortent pas correctement.
Mais je confirme que le fichier est réécrit à chaque fois qu'on lance la commande.
Je suppose que la commande pour supprimer le fichier DSD serait : 

(vl-file-delete fil)

Il serait intéressant de tester si le fichier PDF possède bien le nombre de page requis, si oui on efface le fichier DSD, si non on le laisse. Mais là c'est peut-être un peu too much.


Le formatage du texte avec le "\\pxq[]" je le traite dès le début du traitement du texte, donc normalement c'est bon. 
Dans mes tests j'ai eu ça dans les propriétés "\pxi-3,I4,t4;- LEGENDE -" alors qu'à l'écran le texte affiché est "- LEGENDE -".
Dans le fichier d'impression DSD, on retrouve "\pxi-3,I4,t4;- LEGENDE -", mais bien évidement au moment de l'impression AutoCAD passe outre car il y'a le caractère "\" qui fait partie de la liste des caractères incorrects dans les noms de feuilles "<>/\\":?*|".
J'avoue ne pas avoir fait la démarche jusqu'au bout ... hum hum ... , et donc le plus simple étant de modifier le texte directement afin de ne plus avoir le problème.
Et puis ça permet de dire au projeteur que ce n'est pas la faute au programme si le projeteur fait du n'importe quoi. Si le programme peut lui apporter un peu plus de rigueur je pense que ça ne peut pas lui faire du mal 😉
-> Sauf erreur, je ne vois pas le lien du post de @GEGEMATIC issu du programme STRIPMTEXT 


Pour la partie écriture très répétitive, je voulais me rapprocher de ce qu'on fait actuellement [en mode manuel].
J'ai commencé par laisser en majuscule, mais ça faisait un peu mastoc, puis j'ai mis uniquement la première lettre en majuscule, c'était mieux mais ça manquait d'accents .... bref à ce jour je dirais qu'on doit renommer les signets pour moins de 5% (Ex. renommer "-" en "/", quelques accents qui peuvent manquer [dans le fichier lisp] ...) comparé à avant où on devait le faire en 100% manuel et ce à chaque fois qu'on publiait 😞

Luna Experienced

Luna

Posté(e)
Posté(e)

Autant pour moi, j'ai été trop vite et j'ai oublié le lien STRIPMTEXT... J'ai corrigé mon message précédent.

J'ai vérifié le "\\pxi-3,l4,t4;" et cela semble être lié à la propriété "Première ligne" dans la boîte de dialogue "Paragraphe..." de l'éditeur de texte. Autrement dit, il s'agit du retrait de la première ligne d'un paragraphe (= Alinéa).
Sinon, en effet cela peut permettre de demander plus de rigueur aux dessinateurs pour faciliter le programme.

Bisous,
Luna

JPhil Collaborator

JPhil

Posté(e)
  • Auteur
Posté(e)

Merci Luna.

 

Sur une bonne trentaine (pour ne pas dire plus) de fichiers de test, je ne l'ai vu qu'une seule fois, tout comme le fait d'avoir deux mtext au lieu d'un seul, donc c'est aussi une des raisons pour ne pas trop l'intégrer. Flemme ? Moi ? Nooooooonnnnn 😇

  • 5 mois après...
JPhil Collaborator

JPhil

Posté(e)
  • Auteur
Posté(e)

Je viens de tomber sur un autre formatage bizarre du Mtext, en fait pour être plus précis il s'agit d'une police de texte forcée. 
Le Mtext est en Arial mais le contenu est en "Segoe UI".
Pourquoi faire simple quand on peut faire compliqué 😆

Au passage j'ai aussi traité le "A1".

Si ça peut aider certain(e)s.


Donc il faut remplacer cette partie là : 

;;; Remplacement des caractères
(if (wcmatch folioinfo "*\\P*")
   (while (wcmatch folioinfo "*\\P*")
      (setq folioinfo (vl-string-subst " - " "\\P" folioinfo))
   )
)
(if (wcmatch folioinfo "*/*")
   (while (wcmatch folioinfo "*/*")
      (setq folioinfo (vl-string-subst "-" "/" folioinfo))
   )
)


par cette partie ci : 

;;; Remplacement des caractères
(if (wcmatch folioinfo "*\\P*")
   (while (wcmatch folioinfo "*\\P*")
      (setq folioinfo (vl-string-subst " - " "\\P" folioinfo))
   )
)
(if (wcmatch folioinfo "*\\A1;*")
   (while (wcmatch folioinfo "*\\A1;*")
      (setq folioinfo (vl-string-subst " - " "\\A1;" folioinfo))
   )
)
(if (and (wcmatch folioinfo "*\\f*") (wcmatch folioinfo "*;*"))
   (while (and (wcmatch folioinfo "*\\f*") (wcmatch folioinfo "*;*"))
(setq folioinfo (vl-string-subst "" (substr folioinfo (+ 1 (vl-string-search "\\f" folioinfo)) (- (+ 1 (vl-string-search ";" folioinfo)) (vl-string-search "\\f" folioinfo))) folioinfo))
   )
)
(if (wcmatch folioinfo "*{*")
   (while (wcmatch folioinfo "*{*")
      (setq folioinfo (vl-string-subst "" "{" folioinfo))
   )
)
(if (wcmatch folioinfo "*}*")
   (while (wcmatch folioinfo "*}*")
      (setq folioinfo (vl-string-subst "" "}" folioinfo))
   )
)
(if (wcmatch folioinfo "*/*")
   (while (wcmatch folioinfo "*/*")
      (setq folioinfo (vl-string-subst "-" "/" folioinfo))
   )
)

Je pense que je vais attendre encore un peu avant d'effacer le fichier DSD 😁

  • 8 mois après...
JPhil Collaborator

JPhil

Posté(e)
  • Auteur
Posté(e)

A tout hasard, savez-vous s'il est possible d'avoir au final cette structure :

Fichier PDF
- "Au Clair de la Lune - Folio 1"
- "François à l'Hôtel - Folio 2"

Car actuellement j'ai plutôt cette structure qui commence à me géner :
Fichier PDF
+ "Feuilles et vues"
     - "Au Clair de la Lune - Folio 1"
     - "François à l'Hôtel - Folio 2"


Donc je cherche à savoir s'il est possible de supprimer le signet intermédiaire "Feuilles et vues", mais j'ai l'impression que c'est pas gagné 😕

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
 Partager
Aller sur la liste des sujets
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité