Extraire les blocs d\'un fichier

sicnarf · le 23 juin 2009

Bonjour,

J'ai un fichier dans lequel plusieurs blocs sont définis. Comment pourrais je faire pour exporter automatiquement tous ce blocs afin d'avoir au final un fichier par bloc (manuellement je le fais en insérant dans le fichier chaque bloc, puis en utilisant la commande Wblock).

Merci par avance de votre aide.

PHILPHIL · le 23 juin 2009

hello

avec ce lisp

a+

phil

  ;BtoWB=>Bloc to WBloc
    ;---------------------------
    ;récuperer les blocs internes d'un fichier pour les passer en blocs externes (WBloc)
    ;--------------------------
(defun c:btowb ()
 (setvar "cmdecho" 0)
    ; pour definier les noms longs à changer suivant la version d'autocad et de windows
    ;si nom_long = T alors nom long OK
    ;si nom_long = NIL alors pas de nom long
 (setq nom_long T) ;on liste tous les blocs internes contenus dans le fichier
 (setq lst_bloc nil)
 (setq bloc (tblnext "BLOCK" T))
 (while (/= bloc nil)
   (if	(/= (substr (cdr (assoc 2 bloc)) 1 1) "*")
     (if (/= (wcmatch (cdr (assoc 2 bloc)) "*|*") T)
(setq lst_bloc (append lst_bloc (list (cdr (assoc 2 bloc)))))
     )
   )
   (setq bloc (tblnext "BLOCK"))
 )
 (setq nb_bloc (length lst_bloc))
 (prompt (strcat "\n" (itoa nb_bloc) " BLOCS TROUVES"))
    ;on défini si la création est totale ou si on passe les noms un par un
 (setq compte 0)
 (setq option nil)
 (initget "P T")
 (setq option (getkword "\nCréation Pas à pas ou Tout: "))
 (if (= option "T")
   (progn (repeat nb_bloc (creation_bloc) (setq compte (1+ compte))))
   (progn (repeat nb_bloc
     (setq choix nil)
     (initget "O N")
     (setq
       choix (getkword
	       (strcat "\nBLOC " (itoa (1+ compte)) " = " (nth compte lst_bloc) " > O/N : ")
	     )
     )
     (if (= choix "O")
       (creation_bloc)
     )
     (setq compte (1+ compte))
   )
   )
 )
 (princ)
)

    ;---------------
    ;sous programme creation de bloc
    ;--------------

(defun creation_bloc ()
 (setq existe nil) ;on verifie que le bloc n'existe pas sinon on pose la question de le remplacer
 (setq existe (findfile (strcat (nth compte lst_bloc) ".dwg")))
 (if (= existe nil)
   (if	(= nom_long T)
     (command "WBLOC" (nth compte lst_bloc) (nth compte lst_bloc))
     (command "WBLOC" (substr (nth compte lst_bloc) 1 8) (nth compte lst_bloc))
   )
   (progn (initget "O N")
   (setq efface	(getkword (strcat "\nLe bloc "
				  (nth compte lst_bloc)
				  " éxiste déja, désirez vous le remplacer O/N:"
			  )
		)
   )
   (if (= efface "O")
     (if (= nom_long T)
       (command "WBLOC" (nth compte lst_bloc) "o" (nth compte lst_bloc))
       (command "WBLOC" (substr (nth compte lst_bloc) 1 8) "o" (nth compte lst_bloc))
     )
   )
   )
 )  ;(princ)
)
;;;(prompt "\n======>BTOWB")
;;;(princ)

Raph_38 · le 23 juin 2009

Merci pour ce lisp,

je l'essayerais voir s'il conviens mieux que celui que j'ai au bureau

Raph_38 · le 25 juin 2009

Alors, j'ai testé et franchement ..... bof

il serait bien plus pratique si l'on avait la possibilité de choisir le répertoire où l'on souhaite exporter les blocs.

Là, c'est dans "mes documents" et j'ai mis un certains temps avant de savoir où ils étaient...

Pour info, j'utilise un lisp assez sympa que je mets ici

(désolé les modos si c'est pas le bon endroits, vous pouvez l'enlever si ça ne va pas)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; File: WBLK.LSP (C) Ben Olasov olasov@shadow.cs.columbia.edu 1991 ;;;
;;; Writes all blocks references in drawing to specified directory.  ;;;
;;;                                                                  ;;;
;;; To: christian@fs1-3.arch.fh-hannover.de                          ;;;
;;; From: Ben Olasov                                 ;;;
;;; Subject: Re: ACAD partagiciel                                      ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; File: WBLK.LSP      Copyright (C) Ben Olasov 1991  All Rights Reserved  ;;;
;;; Inquiries:                                                              ;;;
;;;                                                                         ;;;
;;;       Ben Olasov     Lispenard Technologies                             ;;;
;;;                      New York, NY                                       ;;;
;;;                                                                         ;;;
;;;                      Voice:    (212) 274-8506                           ;;;
;;;                      FAX:      (212) 979-3686                           ;;;
;;;                      Arpanet:  olasov@cs.columbia.edu                   ;;;
;;;                      Internet: ben@syska.com                            ;;;
;;;                                                                         ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(VMON)
(gc)

(princ "\nLoading- please wait...")

;; creates wblocks in user-specified path of all blocks in drawing
(defun c:wblk (/ dwgpfx blks tmp foo)
     (setq cmdecho (getvar "cmdecho")
           dwgpfx (getvar "dwgprefix")
           output_path (parse_path (userstr (if output_path output_path dwgpfx)
                                        "\nOutput blocks to which directory")))
     (setvar "cmdecho" 0)
     (setq blks (cdr (assoc 2 (tblnext "BLOCK" T)))
           blks (list (cdr (assoc 2 (tblnext "BLOCK"))) blks))
     (while (setq tmp (tblnext "BLOCK")) 
            (setq blks (cons (cdr (assoc 2 tmp)) blks)))
     (foreach X (clean_blklist blks)
              (if (and (<= (strlen X) 20) (/= (substr x 1 1) "*"))
                  (progn (setq foo (open (strcat output_path x ".dwg") "r"))
                         (if foo (progn (close foo)
                                        (princ (strcat "\nDrawing "
                                                       output_path
                                                       X
                                                       " already exists!")))
                                 (progn (princ (strcase (strcat "\nWriting " output_path X ".dwg") t))
                                        (command "_wblock" (strcat output_path X) X))))))
     (setvar "cmdecho" cmdecho)
      'done)

;; get a user string with default
(defun userstr (dflt prmpt / var) ;;DFLT and PRMPT are strings
      (setq var (getstring (if (and dflt (/= dflt ""))
                               (strcat prmpt " <" dflt ">: ")
                               (strcat prmpt ": "))))
      (cond ((/= var "") var)
            ((and dflt (= var "")) dflt)
            (T "")))

;; parse a user's path response
(defun parse_path (s / STRL FIRSTC SECONDC LASTC)
      (cond ((null s) nil) ;; is S bound?
            ((= s "") s)   ;; is S an empty string?
            (T (setq STRL (strlen s)
                     FIRSTC (substr s 1 1)
                     SECONDC (substr s 2 1)
                     LASTC (substr s STRL 1))
               (cond ((= STRL 1)  ;; if S has only one character
                      (if (or (= FIRSTC "/")   ;; and the 1st char is "/"
                              (= FIRSTC "\\")) ;; or "\\"
                          "\\"                 ;; return the 1st char
                          (strcat DWGPFX S "\\"))) ;; otherwise prepend DWGPFX
                                                  ;; and append a "\\"
                     ((or (and (= FIRSTC "/")  ;; if the user pathname
                               (= LASTC "/"))  ;; looks superficially
                          (and (= FIRSTC "\\") ;; well-formed, return it.
                               (= LASTC "\\"))) S)
                     ((and (/= FIRSTC "/")
                           (/= FIRSTC "\\"))  ;; the 1st char isn't /
                      (cond ((= SECONDC ":")  ;; is it a drive spec?
                             (if (and (/= LASTC "/") ;; make sure there's
                                      (/= LASTC "\\")) ;; a slash on the end
                                 (strcat S "\\")
                                 S))
                            ((and (/= LASTC "/")
                                  (/= LASTC "\\"))
                             (strcat DWGPFX S "\\"))))
                     (T s)))))

;; removes atom ATM from list of unique atoms LST
(defun aux_remove (atm lst) 
    (cond ((null lst) NIL) 
          ((null (member atm lst)) lst) 
          ((equal atm (car lst)) 
           (cdr lst)) 
          (t (append (reverse (cdr (member atm (reverse lst))))
                     (cdr (member atm lst)))))) 

;; removes HATCH references and blocks with names longer than 8 chars
(defun clean_blklist (blklist / bl)
      (setq bl blklist)
      (if (and bl (listp bl))
          (foreach blk bl
                   (if (or (null blk)
                           (= (substr blk 1 1) "*")
                           (> (strlen blk) 20))
                       (progn (princ (strcat
            "\nRemoving " blk " from block list."))
                              (setq bl (aux_remove blk bl))))))
      bl)

(princ "\nType WBLK to write out all block references to a user-specified directory.")
(princ)

Bred · le 25 juin 2009

Salut,

pour compléter, j'avais fait un truc simpliste dernièrement, qui répond aussi à ta demande.

mais ça reste du lisp, désolé, pas du VB.

http://www.cadxp.com/modules.php?op=modload&name=XForum&file=viewthread&tid=17630#pid71925

sicnarf · le 25 juin 2009

Merci pour vos réponses.

J'ai utilisé le lisp de PhilPhil qui fonctionne très bien avec comme le fait remarquer neptune38 une inconnue sur le répertoire où sont enregistrés les blocs (pour ma part cela n'a pas été systématiquement le répertoire mes documents, mais surtout le répertoire du premier fichier ouvert avec autocad...).

Sinon j'ai eu un petit pb, non lié au lisp : à chaque exportation d'un bloc, une boite de dialogue s'ouvrait et demandait "Inclure les informations AutoCAD Map dans l'exportation ?". Je ne suis pas arrivé à inclure une réponse par défaut dans le lisp. Si quelqu'un a une idée....

Je suis sous Autocad Civil 3D 2008 et me fichier que j'utilise vient de mensura.

Raph_38 · le 27 juin 2009

Essaye celui que j'ai mis, il marche pas mal sauf quand les noms de blocs sont trop long. ... dans ce cas, il ne les exportent pas.

denis38 · le 27 juillet 2009

Salut a tous,

pour moi les deux lisp son identique

il faut toujours valide la fenêtre inclure les information AutoCAD Map dans l'explorateur

comment fait on pour supprimé cette action.

Car mon projet et de faire ça su tout les fichier d'un répertoire avec un script derrière le tout en automatique

merci pour vos réponse

bonne vacances a tout ce qui parte en fin de semaine

Denis

Hyppolight · le 21 février

Bonjour,

Je sais que ce message est très ancien mais ayant trouvé une partie de code de Jimmy Bergmark dans sa commande "LayoutsToDwgs.lsp" pouvant être adaptée pour l'extraction de tous les blocs dans AutoCAD MAP sans avoir le message "Inclure les informations AutoCAD MAP dans l'exportation", je me permet de partager.

https://jtbworld.com/autocad-export-layouts-to-drawings-layoutstodwgs-lsp

La partie du code d'origine modifiée:

(foreach blk lst
	(setq fn (strcat path (chr 92) blk))
	(if (findfile (strcat fn ".dwg"))
		(command "_.WBLOCK" fn "_Y" blk)
		(command "_.WBLOCK" fn blk)
	)
)

Le code modifié :

(setq msg "" msg2 "" i 0 j 0)
			
(foreach blk lst
	(setq fn (strcat path (chr 92) blk))
	(if (findfile (strcat fn ".dwg"))
		(progn
			(command "_.-WBLOCK" fn "_Y" blk)
			(if (equal 1 (logand 1 (getvar "cmdactive")))
				(progn
					(setq i (1+ i) msg (strcat msg "\n" fn))
					(command "*")
				)
				(setq j (1+ j) msg2 (strcat msg2 "\n" fn))
			)
		)
		(progn
			(command "_.-WBLOCK" fn blk)
			(setq i (1+ i)  msg (strcat msg "\n" fn))
		)
	)
	(if (equal 1 (logand 1 (getvar "cmdactive")))
	  (command "_Y")
	)
)

Code complet :

; ----------------------------------------------------------------------
;          (Wblocks all local block definitions to target path)
;            Copyright (C) 2000 DotSoft, All Rights Reserved
;                   Website: http://www.dotsoft.com
; ----------------------------------------------------------------------
; DISCLAIMER:  DotSoft Disclaims any and all liability for any damages
; arising out of the use or operation, or inability to use the software.
; FURTHERMORE, User agrees to hold DotSoft harmless from such claims.
; DotSoft makes no warranty, either expressed or implied, as to the
; fitness of this product for a particular purpose.  All materials are
; to be considered ‘as-is’, and use of this software should be
; considered as AT YOUR OWN RISK.
; ----------------------------------------------------------------------

(defun c:wba ()
	(setq cmdecho (getvar "CMDECHO"))
	(setq expert (getvar "EXPERT"))
	(setq cmddia (getvar "CMDDIA"))
	(setvar "CMDECHO" 0)
	(setvar "EXPERT" 2)
	(setvar "CMDDIA" 0)
	
	;
	(if (not dos_getdir)
		(setq path (getstring "\nDS> Dossier cible: " T))
		(setq path (dos_getdir "Dossier cible" (getvar "DWGPREFIX")))
	)
	(if (/= path nil)
		(progn
			(if (= (substr path (strlen path) 1) "\\")
				(setq path (substr path 1 (1- (strlen path))))
			) 
			(princ "\nDS> Création de la liste de blocs ... ")
			(setq lst nil)
			(setq itm (tblnext "BLOCK" T))
			(while (/= itm nil)
				(setq nam (cdr (assoc 2 itm)))
				(setq pass T)
				(if (/= (cdr (assoc 1 itm)) nil)
					(setq pass nil)
					(progn
						(setq ctr 1)
						(repeat (strlen nam)
							(setq chk (substr nam ctr 1))
							(if (or (= chk "*")(= chk "|"))
								(setq pass nil)
							)
							(setq ctr (1+ ctr))
						)
					)
				)
				(if (= pass T)
					(setq lst (cons nam lst))
				)
				(setq itm (tblnext "BLOCK"))
			)
			(setq lst (acad_strlsort lst))
			(princ "Fait.")
			
			;
			;(foreach blk lst
			;	(setq fn (strcat path (chr 92) blk))
			;	(if (findfile (strcat fn ".dwg"))
			;		(command "_.WBLOCK" fn "_Y" blk)
			;		(command "_.WBLOCK" fn blk)
			;	)
			;)
			(setq msg "" msg2 "" i 0 j 0)
			
			(foreach blk lst
				(setq fn (strcat path (chr 92) blk))
				(if (findfile (strcat fn ".dwg"))
					(progn
						(command "_.-WBLOCK" fn "_Y" blk)
						(if (equal 1 (logand 1 (getvar "cmdactive")))
							(progn
								(setq i (1+ i) msg (strcat msg "\n" fn))
								(command "*")
							)
							(setq j (1+ j) msg2 (strcat msg2 "\n" fn))
						)
					)
					(progn
						(command "_.-WBLOCK" fn blk)
						(setq i (1+ i)  msg (strcat msg "\n" fn))
					)
				)
				(if (equal 1 (logand 1 (getvar "cmdactive")))
				  ; Include AutoCAD Map information in the export?
				  ; If you don't want to include Map information in the new files change "_Y" to "_N" below
				  (command "_Y")
				)
			)
			
		)
	)
	;
	(setvar "CMDECHO" cmdecho)
	(setvar "EXPERT" expert)
	(setvar "CMDDIA" cmddia)
	
	(princ)
)

A+ Yoan

Connexion

Extraire les blocs d\'un fichier

Messages recommandés

sicnarf

PHILPHIL

Raph_38

Raph_38

Bred

sicnarf

Raph_38

denis38

Hyppolight

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante