Lisp per blocchi

[Bez]

Un po' di tempo fa mi era sembrato di leggere
all'interno di questo NG di una lisp che esportava
i blocchi all'interno di un file in una cartella.
In sostanza faceva tanti mblock e nella cartella di
destinazione ci si ritrovava tutti i singoli files
dei blocchi che erano presenti nel file di riferimento.

Grazie del remembering
Bez

[arri]

Lets you designate a target path and automatically wblock all block
definitions in the drawing to that folder

http://www.dotsoft.com/public/wblockm.lsp

[Bez]

Post by arri
Lets you designate a target path and automatically wblock all block
definitions in the drawing to that folder
http://www.dotsoft.com/public/wblockm.lsp

Dovrebbe essere questa, mitico arri ma con la 2007 mi
fa una sfilza di:

..cut
Inizializzazione in corso...
Inizializzazione in corso...
Inizializzazione in corso...
Inizializzazione in corso...
Inizializzazione in corso...
Inizializzazione in corso...Funzione annullata
Comando:
Comando: *Annullato*
cut

...e se non lo fermo io....
ovviamente la blocco con esc quindi
non funzia.

:-(

[Gattaccio Nero]

Ciao Bez
Ho buttato giù due righe che dovrebbero funzionare (nella 2000 funziona e
direi che non ci sono motivi per cui non debba funzionare nelle versioni
superiori).

;;;---------------------INIZIO

(defun c:makewblock ( / fla dat blk)

(setvar "cmdecho" 1)
(setvar "highlight" 1)
(prompt "\nCreazione di file dai blocchi presenti nel disegno.")

(setq fla T)
(while
(setq dat (tblnext "block" fla))
(setq blk (cdr (assoc 2 dat )))

(if (not (= (substr blk 1 1) "*"))(command "_wblock" blk blk))
(setq fla nil)
)
(princ)
)

;;; --------------FINE

Fà tutto da solo e tira fuori tutti i blocchi del disegno ovvaimnte senza
retini, blocchi quote o blocchi senza nome.
E' un pò spartano, si poteva aggiungere la cartella dove metterli...cmq...se
ti basta... ^^

Ovviamente da incollare in un file con estensione .LSP

Maowww

[Marco_AA]

un lisp che esportava i blocchi all'interno di un file in una cartella...

Con questo puoi scegliere la destinazione e i nomi dei blocchi:

; Marc'Antonio Alessi - http://xoomer.alice.it/alessi
;
; Funzione: C:ALE_Block_WriteMultiple
;
; Versione 1.00 - 04/03/2005
;
; Note:
; i file esistenti nella destinazione saranno eventualmente sovrascritti,
; l'esportazione non avviene se si cerca di sovrascrivere files in uso
; o in sola lettura
;
(defun C:ALE_Block_WriteMultiple ( / Countr OutPat BlkNms TblDat BlkNam EntDat OutFil)
(if
(and
(setq
Countr 0
OutPat (ALE_BrowseForFolder "Seleziona la destinazione:" 48 "")
)
(setq BlkNms (strcase (getstring "\nNome del blocco o parte del nome <*>: ")))
)
(progn
(and (eq BlkNms "") (setq BlkNms "*"))
(while (setq TblDat (tblnext "BLOCK" (not TblDat)))
(setq
BlkNam (cdr (assoc 2 TblDat))
EntDat (entget (tblobjname "BLOCK" BlkNam))
)
(if
(and
(zerop (logand 61 (cdr (assoc 70 EntDat))))
(wcmatch (strcase (cdr (assoc 2 EntDat))) BlkNms)
)
(progn
(setq OutFil (strcat OutPat "\\" BlkNam ".dwg"))
(vl-catch-all-apply
'(lambda ( )
(if (eq 1 (logand 1 (getvar "CMDACTIVE")))
(repeat 4 (command))
)
(if (findfile OutFil)
(command "._-WBLOCK" OutFil "_Y" BlkNam)
(command "._-WBLOCK" OutFil BlkNam)
)
(setq Countr (1+ Countr))
)
)
)
)
)
)
)
(princ (strcat "\n" (itoa Countr) "blocchi esportati. "))
(princ)
)
;
; Marc'Antonio Alessi - http://xoomer.alice.it/alessi
;
; Function: ALE_BrowseForFolder
;
; Version 1.01 - 10/11/2005
;
; Example: (ALE_BrowseForFolder "Select a folder:" 48 "C:\\Temp\\")
; > "C:\\Temp"
;
; ulFlags - value of iOptns
;
; 1 RestrictToFilesystem = &H1 ' BIF_RETURNONLYFSDIRS
; 2 RestrictToDomain = &H2 ' BIF_DONTGOBELOWDOMAIN
; 8 RestrictToSubfolders = &H8 ' BIF_RETURNFSANCESTORS
; 16 ShowTextBox = &H10 ' BIF_EDITBOX
; 32 ValidateSelection = &H20 ' BIF_VALIDATE
; 64 NewDialogStyle = &H40 ' BIF_NEWDIALOGSTYLE
; 4096 BrowseForComputer = &H1000 ' BIF_BROWSEFORCOMPUTER
; 8192 BrowseForPrinter = &H2000 ' BIF_BROWSEFORPRINTER
; 16384 BrowseForEverything = &H4000 ' BIF_BROWSEINCLUDEFILES
;
; In this sample I use iOptns = 48 > 16 + 32
;
; Credits: Tony Tanzillo - Tim Willey
;
; VLA Acad globals: *AcadApp* = Acad.Application
;
; Vla-get-HWND note from Tim Willey: I set that up because I use dual
; monitors and it would pop up between both screens. After I set it, it popped
; in in the correct location, in the middle of the current Acad screen.
;
(defun ALE_BrowseForFolder (PrmStr iOptns DefFld / ShlObj Folder FldObj OutVal)
(vl-load-com)
(or *AcadApp* (setq *AcadApp* (vlax-get-acad-object)))
(setq
ShlObj (vla-getInterfaceObject *AcadApp* "Shell.Application")
Folder (vlax-invoke-method ShlObj
'BrowseForFolder (vla-get-HWND *AcadApp*) PrmStr iOptns DefFld
)
)
(vlax-release-object ShlObj)
(if Folder
(progn
(setq
FldObj (vlax-get-property Folder 'Self)
OutVal (vlax-get-property FldObj 'Path)
)
(vlax-release-object Folder)
(vlax-release-object FldObj)
OutVal
)
)
)