Aller au contenu

CREER DES EXTRAITS DE FICHIER


PHILPHIL

Messages recommandés

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)
      )
   )
 )
)

Autodesk Architecture 2023 sous windows 11 64

24 pouces vertical + 30 pouces horizontal + 27 pouces horizontal

Lien vers le commentaire
Partager sur d’autres sites

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
×
×
  • 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é