CREER DES EXTRAITS DE FICHIER

[PHILPHIL]

bonjour

 

MISE A JOUR : MISE A L ECHELLE DU FICHIER SAUVEGARDE

 

je recois des fois des fichiers avec toutes les présentations dans l'espace objet et a des échelles différentes non égales a l'échelle 1

 

 

voici une fonction pour faire des extraits de fichier en dwg

 

etape1 : choisir le repertoire d'extraction

 

sauve_repertoire_bloc

 

etape 2 : choisir un nom d'extraction dwg, choisir objets, choisir point de base

 

fichier_extrait_fichier_repertoire_bloc

fichier_extrait_fichier_repertoire_bloc_mise_echelle

 

 

il faut les express tools je pense ( pour choisir le sous repertoire de sauvegarde )

 

ps1 : merci a Gile pour ses routines

ps2 : on ne peut plus déposer de fichier *.lsp ??

 

a+

 

Phil

 

 

(setcustombykey "REPERTOIRE_BLOC" "...")



;;;-------------------------------------------------
;;;SAUVEGARDER FAIRE DES EXTRAITS DE FICHIERS EN DWG
;;;-------------------------------------------------

(defun c:fichier_extrait_fichier_repertoire_bloc ()
 (setvar "cmdecho" 0) ; pour definier les noms longs à changer suivant la version d'autocad et de windows
 (setq repertoire_bloc (gc:getcustombykey "REPERTOIRE_BLOC"))
 (prompt (strcat "\nLE REPERTOIRE DES BLOCS DE L'OPERATION EST : " repertoire_bloc))
 (setq nomextraitfichier (getcfg "APPDATA/NOMEXTRAITFICHIER"))
 (setq boite "ENTRER LE NOM DU FICHIER DE SAUVEGARDE DE L'EXTRAIT ")
 (setq message "NOUVEAU NOM DE L'EXTRAIT")
 (inputbox2 boite message nomextraitfichier)
 (if (/= ret "")
   (setq nomextraitfichier ret)
 )
 (setcfg "APPDATA/NOMEXTRAITFICHIER" nomextraitfichier)
 (setq poi nil)
 (while (null poi) (setq poi (getpoint "\nPOINT DE REFERENCE DU FICHIER EXTRAIT")))
 (prompt (strcat "\nCLIQUER SUR LES OBJETS A EXTRAIRE DANS UN FICHIER"))
 (setq obj nil)
 (while (null obj) (setq obj (ssget)))
 (command-s "scu" "ez" poi "")
 (command-s "-WBLOC" (strcat repertoire_bloc "\\" nomextraitfichier ".DWG") "" poi obj "")
 (command-s "ANNULER" "")
 (command-s "scu" "p")
 (princ)
)

(defun c:fichier_extrait_fichier_repertoire_bloc_mise_echelle ()
 (setvar "cmdecho" 0) ; pour definier les noms longs à changer suivant la version d'autocad et de windows
 (setq repertoire_bloc (gc:getcustombykey "REPERTOIRE_BLOC"))
 (prompt (strcat "\nLE REPERTOIRE DES BLOCS DE L'OPERATION EST : " repertoire_bloc))
 (setq nomextraitfichier (getcfg "APPDATA/NOMEXTRAITFICHIER"))
 (setq boite "ENTRER LE NOM DU FICHIER DE SAUVEGARDE DE L'EXTRAIT ")
 (setq message "NOUVEAU NOM DE L'EXTRAIT")
 (inputbox2 boite message nomextraitfichier)
 (if (/= ret "")
   (setq nomextraitfichier ret)
 )
 (setcfg "APPDATA/NOMEXTRAITFICHIER" nomextraitfichier)

(setq refech2 (atof (getcfg "APPDATA/refech2")))
 (initget 4)
 (setq tmp (getdist (strcat "\nENTRER LA VALEUR DE MISE A L'ECHELLE < " (rtos refech2 2 8) " >: ")))
 (if tmp
   (setq refech2 tmp)
 )
 (setcfg "APPDATA/refech2" (rtos refech2 2 8))
 (setq poi nil)
 (while (null poi) (setq poi (getpoint "\nPOINT DE REFERENCE DU FICHIER EXTRAIT")))
 (prompt (strcat "\nCLIQUER SUR LES OBJETS A EXTRAIRE DANS UN FICHIER"))
 (setq obj nil)
 (while (null obj) (setq obj (ssget)))
 (command-s "scu" "ez" poi "")
 (command-s "ECHELLE" obj "" "0,0,0" refech2)
 (command-s "-WBLOC" (strcat repertoire_bloc "\\" nomextraitfichier ".DWG") "" poi obj "")
 (command-s "ANNULER" "")
 (command-s "ANNULER" "")
 (command-s "scu" "p")
 (princ)
)

;; InputBox (gile)
;; Ouvre une boite de dialogue pour récupérer une valeur
;; sous forme de chaine de caractère
;;
;; Arguments
;; tous les arguments sont de chaines de caractère (ou "")
;; box : titre de la boite de dialogue
;; msg : message d'invite
;; val : valeur par défaut
;;
;; Retour
;; une chaine ("" si annulation)
;;
;; Modifié par Patrick_35 pour inclure le caractère \n
;; comme retour chariot

(defun inputbox2 (box msg val / subr temp file dcl_id
                                              ;;ret
) ;; Retour chariot automatique à 50 caractères
 (defun subr (str / pos)
   (cond ((setq pos (vl-string-search "\n" str))
          (strcat ":text_part{label=\"" (substr str 1 pos) "\";}" (subr (substr str (+ 2 pos))))
         )
         ((and (< 80 (strlen str)) (setq pos (vl-string-position 32 (substr str 1 80) nil t)))
          (strcat ":text_part{label=\"" (substr str 1 pos) "\";}" (subr (substr str (+ 2 pos))))
         )
         (t (strcat ":text_part{label=\"" str "\";}"))
   )
 )
 ;; Créer un fichier DCL temporaire
 (setq temp (vl-filename-mktemp "Tmp.dcl")
       file (open temp "w")
       ret  ""
 )
 ;; Ecrire le fichier
 (write-line (strcat "InputBox:dialog{key=\"box\";initial_focus=\"val\";spacer;:paragraph{"
                     (subr msg)
                     "}spacer;:edit_box{key=\"val\";edit_width=120;allow_accept=true;}
spacer;ok_cancel;}"
             )
             file
 )
 (close file)
 ;; Ouvrir la boite de dialogue
 (setq dcl_id (load_dialog temp))
 (if (not (new_dialog "InputBox" dcl_id))
   (exit)
 )
 (set_tile "box" box)
 (set_tile "val" val)
 (action_tile "accept" "(setq ret (get_tile \"val\")) (done_dialog)")
 (start_dialog)
 (unload_dialog dcl_id)
 ;;Supprimer le fichier
 (vl-file-delete temp)
 ret
)


(defun gc:getcustombykey (key / val)
 (vl-catch-all-apply
   '(lambda ()
      (vla-getcustombykey (vla-get-summaryinfo (vla-get-activedocument (vlax-get-acad-object))) key 'val)
    )
 )
 val
)



;;; Commande sauve_repertoire_bloc
;;;Invite l'utilisateur à choisir un sous répertoire qui sera sauvegarder dans le fichier (boites de dialogue)

(defun c:sauve_repertoire_bloc (/ dirbox rep)
 (defun dirbox (txt / cdl rep)
   (if (setq cdl (vlax-create-object "Shell.Application"))
     (progn (and (setq rep (vlax-invoke cdl 'browseforfolder 0 txt 512 ""))
                 (setq rep (vlax-get-property (vlax-get-property rep 'self) 'path))
            )
            (vlax-release-object cdl)
     )
   )
   rep
 )
 (setq repertoirebloc (gc:getcustombykey "REPERTOIRE_BLOC"))
 (if (= repertoirebloc "...")
   (prompt "\nIL N'Y A PAS DE REPERTOIRE POUR LES BLOCS :")
   (prompt (strcat "\nLA VALEUR ACTUELLE DE REPERTOIRE_BLOC EST :" repertoirebloc " "))
 )
 (princ)
 (princ)
 (setq rep (dirbox "CHSOISISSEZ UN REPERTOIRE OU SERONT RECHERCHES / SAUVEGARDES LES BLOCS DU DESSIN."))
 (setcustombykey1 "REPERTOIRE_BLOC" rep)
 (princ)
)


(defun setcustombykey (key val)
 (vl-load-com)
 (not
   (vl-catch-all-apply
     '(lambda ()
        (vla-addcustominfo (vla-get-summaryinfo (vla-get-activedocument (vlax-get-acad-object))) key val)
      )
   )
 )
)


(defun setcustombykey1 (key val)
 (vl-load-com)
 (not
   (vl-catch-all-apply
     '(lambda ()
        (vla-setcustombykey (vla-get-summaryinfo (vla-get-activedocument (vlax-get-acad-object))) key val)
      )
   )
 )
)