| Autore |
 Discussione  |
|
|
zenobio
Utente Medio
Regione: Veneto
Prov.: Venezia
Città: san michele al tagliamento
33 Messaggi |
 Inserito il - 10 maggio 2012 : 18:50:38
|
Ciao
è da ieri che cerco in giro una soluzione ad una cosa su cui mi sono intestardito. Ho trovato la lisp, che riporto più avanti, che serve ad esportare tutti i blocchi contenuti in un disegno. La lisp funziona ma chiede l'immissione della cartella da rigo di comando, ho cercato e provato alcuni comandi, mi sono guardato un po' le varie guide (consigliatemi da Arri) ma non ho o non sono stato capace di trovare i modo di immettere il percorso da finestra di dialogo. Ho provato con getfilet con findfile e vl-filename-directory ma si presuppone di avere un qualche tipo di file già presente nella cartella a me invece interesserebbe poter puntare su una cartella vuota.
; ----------------------------------------------------------------------
; (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:wblockm ()
(setq cmdecho (getvar "CMDECHO"))
(setvar "CMDECHO" 1)
;
(if (not dos_getdir)
(setq path (getstring "\nDS> Target Folder: " T)) ; <-- linea che vorrei modificare
(setq path (dos_getdir "Target Folder" (getvar "DWGPREFIX")))
)
(if (/= path nil)
(progn
(if (= (substr path (strlen path) 1) "\\")
(setq path (substr path 1 (1- (strlen path))))
)
(princ "\nDS> Building List of Blocks ... ")
(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 "Done.")
;
(foreach blk lst
(setq fn (strcat path (chr 92) blk))
(if (findfile (strcat fn ".dwg"))
(command "_.WBLOCK" fn "_Y" blk)
(command "_.WBLOCK" fn blk)
)
)
)
)
;
(setvar "CMDECHO" cmdecho)
(princ)
)
Ho provato anche a cancellare la riga che volevo modificare in modo che si auto impostasse nella cartella dove si trova il disegno ma sembra che zwcad non digerisca "dos_getdir" riguardo al quale ho fatto ricerche ma non sono riuscito a trovare cosa dovrebbe fare, ad intuito la traduzione indirizza ad una cartella dos.
Di un'altra cosa non ho trovato spiegazione (forse non ho letto tutte le 980 pagine consigliatemi da Arri) perchè dopo il comando getstring
c'è \nDS> di solito non è \n che differenza c'è??
|
|
|
arri
Utente Master
Regione: Lombardia
14951 Messaggi |
|
|
zenobio
Utente Medio
Regione: Veneto
Prov.: Venezia
Città: san michele al tagliamento
33 Messaggi |
Inserito il - 11 maggio 2012 : 05:54:10
|
Grazie Arri
ma come accennavo uso zwcad che non supporta i vlx dovrei convertirli in zrx ma non ho ancora imparato a farlo, al momento mi limito a provare delle modifiche nei lisp e anche qui con scarso successo come si può notare. |
Modificato da - zenobio in data 11 maggio 2012 05:56:49 |
 |
|
|
arri
Utente Master
Regione: Lombardia
14951 Messaggi |
Inserito il - 11 maggio 2012 : 08:01:48
|
Messaggio di zenobio
a me invece interesserebbe poter puntare su una cartella vuota.
prova questo
(defun c:WBKA ( / fla dat blk)
(prompt "\nEstrae tutti i 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))
|
|
|
|
zenobio
Utente Medio
Regione: Veneto
Prov.: Venezia
Città: san michele al tagliamento
33 Messaggi |
Inserito il - 11 maggio 2012 : 09:02:40
|
Avevo già provato questa lisp ma non chiede dove esportali e li salva direttamente nella cartella principale del programma.
Tra le varie lisp che ho trovato in giro quella riportata sopra è quella che mi gira meglio è per quello che ho chiesto consiglio su quella. |
Modificato da - zenobio in data 11 maggio 2012 09:06:02 |
|
|
|
arri
Utente Master
Regione: Lombardia
14951 Messaggi |
Inserito il - 11 maggio 2012 : 09:15:12
|
Messaggio inserito da zenobio
li salva direttamente nella cartella principale del programma.
tasto destro sull'icona del tuo programma,
proprietà
e imposti la cartella che vuoi,
i blocchi saranno salvati in quella cartella
Immagine inserita:
119,79 KB |
|
|
|
zenobio
Utente Medio
Regione: Veneto
Prov.: Venezia
Città: san michele al tagliamento
33 Messaggi |
Inserito il - 12 maggio 2012 : 11:30:35
|
Ciao
ho provato ad inserire una subroutine che sembrava fare al caso mio ed ho modificato la lisp come segue
; prova parte WW
(defun c:ww ( / *error* path )
(vl-load-com)
(setq cmdecho (getvar "CMDECHO"))
(setvar "CMDECHO" 1)
(defun *error* ( msg )
(if (and dir (eq 'dir (type dir))) (close dir))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
;______________________________________________________________________________
(if
(setq dir
(LM:DirDialog
(strcat
"Selezionare la cartella dove salvare i blocchi.\n"
)
nil 832
)
)
(setq dir (vl-string-translate "\\" "/" dir))
)
; (princ dir)
; ----------------------------------------------------------------------
; (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.
; ----------------------------------------------------------------------
(if (/= dir nil)
(progn
(if (= (substr dir (strlen dir) 1) "\\")
(setq dir (substr dir 1 (1- (strlen dir))))
)
(princ "\nDS> Building List of Blocks ... ")
(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 "Done.")
;
(foreach blk lst
(setq fn (strcat path (chr 92) blk))
(if (findfile (strcat fn ".dwg"))
(command "_.WBLOCK" fn "_Y" blk)
(command "_.WBLOCK" fn blk)
)
)
)
)
;
(princ dir)
; (princ path)
(setvar "CMDECHO" cmdecho)
(princ "\nEnter wblockm to start.")
(princ)
)
;;-------------------=={ Directory Dialog }==-----------------;;
;; ;;
;; Displays a dialog prompting the user to select a folder ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; msg - message to display at top of dialog ;;
;; dir - root directory (or nil) ;;
;; flag - bit coded flag specifying dialog display settings ;;
;;------------------------------------------------------------;;
;; Returns: Selected folder filepath, else nil ;;
;;------------------------------------------------------------;;
(defun LM:DirDialog ( msg dir flag / Shell HWND Fold Self Path ac )
(vl-load-com)
;; © Lee Mac 2010
(setq Shell (vla-getInterfaceObject (setq ac (vlax-get-acad-object)) "Shell.Application")
HWND (vl-catch-all-apply 'vla-get-HWND (list ac))
Fold (vlax-invoke-method Shell 'BrowseForFolder (if (vl-catch-all-error-p HWND) 0 HWND) msg flag dir))
(vlax-release-object Shell)
(if Fold
(progn
(setq Self (vlax-get-property Fold 'Self) Path (vlax-get-property Self 'Path))
(vlax-release-object Self)
(vlax-release-object Fold)
(and (= "\\" (substr Path (strlen Path)))
(setq Path (substr Path 1 (1- (strlen Path)))))
)
)
Path
)
ho modificato nella parte principale del precedente programma la variabile path con dir perchè non andasse in conflitto con il resto ed ho messo in princ per vedere se la variabile dir impostata punta alla cartella selezionata e fin qui tutto bene il problema è che poi il programma gira ma non salva niente. |
Modificato da - zenobio in data 12 maggio 2012 16:05:55 |
|
|
|
arri
Utente Master
Regione: Lombardia
14951 Messaggi |
Inserito il - 12 maggio 2012 : 16:59:25
|
Messaggio inserito da zenobio
Ciao
ho provato ad inserire una subroutine che sembrava fare al caso mio ed ho modificato la lisp come segue
; prova parte WW
(defun c:ww ( / *error* path )
(vl-load-com)
(setq cmdecho (getvar "CMDECHO"))
(setvar "CMDECHO" 1)
(defun *error* ( msg )
(if (and dir (eq 'dir (type dir))) (close dir))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
;______________________________________________________________________________
(if
(setq dir
(LM:DirDialog
(strcat
"Selezionare la cartella dove salvare i blocchi.\n"
)
nil 832
)
)
(setq dir (vl-string-translate "\\" "/" dir))
)
; (princ dir)
; ----------------------------------------------------------------------
; (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.
; ----------------------------------------------------------------------
(if (/= dir nil)
(progn
(if (= (substr dir (strlen dir) 1) "\\")
(setq dir (substr dir 1 (1- (strlen dir))))
)
(princ "\nDS> Building List of Blocks ... ")
(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 "Done.")
;
(foreach blk lst
(setq fn (strcat path (chr 92) blk))
(if (findfile (strcat fn ".dwg"))
(command "_.WBLOCK" fn "_Y" blk)
(command "_.WBLOCK" fn blk)
)
)
)
)
;
(princ dir)
; (princ path)
(setvar "CMDECHO" cmdecho)
(princ "\nEnter wblockm to start.")
(princ)
)
;;-------------------=={ Directory Dialog }==-----------------;;
;; ;;
;; Displays a dialog prompting the user to select a folder ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; msg - message to display at top of dialog ;;
;; dir - root directory (or nil) ;;
;; flag - bit coded flag specifying dialog display settings ;;
;;------------------------------------------------------------;;
;; Returns: Selected folder filepath, else nil ;;
;;------------------------------------------------------------;;
(defun LM:DirDialog ( msg dir flag / Shell HWND Fold Self Path ac )
(vl-load-com)
;; © Lee Mac 2010
(setq Shell (vla-getInterfaceObject (setq ac (vlax-get-acad-object)) "Shell.Application")
HWND (vl-catch-all-apply 'vla-get-HWND (list ac))
Fold (vlax-invoke-method Shell 'BrowseForFolder (if (vl-catch-all-error-p HWND) 0 HWND) msg flag dir))
(vlax-release-object Shell)
(if Fold
(progn
(setq Self (vlax-get-property Fold 'Self) Path (vlax-get-property Self 'Path))
(vlax-release-object Self)
(vlax-release-object Fold)
(and (= "\\" (substr Path (strlen Path)))
(setq Path (substr Path 1 (1- (strlen Path)))))
)
)
Path
)
ho modificato nella parte principale del precedente programma la variabile path con dir perchè non andasse in conflitto con il resto ed ho messo in princ per vedere se la variabile dir impostata punta alla cartella selezionata e fin qui tutto bene il problema è che poi il programma gira ma non salva niente.
in rosso la modifica
(defun c:ww ( / *error* path )
(vl-load-com)
(setq cmdecho (getvar "CMDECHO"))
(setvar "CMDECHO" 1)
(defun *error* ( msg )
(if (and dir (eq 'dir (type dir))) (close dir))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
;______________________________________________________________________________
(if
(setq dir
(LM:DirDialog
(strcat
"Selezionare la cartella dove salvare i blocchi.\n"
)
nil 832
)
)
(setq dir (vl-string-translate "\\" "/" dir))
)
; (princ dir)
; ----------------------------------------------------------------------
; (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.
; ----------------------------------------------------------------------
(if (/= dir nil)
(progn
(if (= (substr dir (strlen dir) 1) "\\")
(setq dir (substr dir 1 (1- (strlen dir))))
)
(princ "\nDS> Building List of Blocks ... ")
(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 "Done.")
;
(foreach blk lst
(setq fn (strcat dir (chr 92) blk))
(if (findfile (strcat fn ".dwg"))
(command "_.WBLOCK" fn "_Y" blk)
(command "_.WBLOCK" fn blk)
)
)
)
)
;
(princ dir)
; (princ path)
(setvar "CMDECHO" cmdecho)
(princ "\nEnter wblockm to start.")
(princ)
)
;;-------------------=={ Directory Dialog }==-----------------;;
;; ;;
;; Displays a dialog prompting the user to select a folder ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; msg - message to display at top of dialog ;;
;; dir - root directory (or nil) ;;
;; flag - bit coded flag specifying dialog display settings ;;
;;------------------------------------------------------------;;
;; Returns: Selected folder filepath, else nil ;;
;;------------------------------------------------------------;;
(defun LM:DirDialog ( msg dir flag / Shell HWND Fold Self Path ac )
(vl-load-com)
;; © Lee Mac 2010
(setq Shell (vla-getInterfaceObject (setq ac (vlax-get-acad-object)) "Shell.Application")
HWND (vl-catch-all-apply 'vla-get-HWND (list ac))
Fold (vlax-invoke-method Shell 'BrowseForFolder (if (vl-catch-all-error-p HWND) 0 HWND) msg flag dir))
(vlax-release-object Shell)
(if Fold
(progn
(setq Self (vlax-get-property Fold 'Self) Path (vlax-get-property Self 'Path))
(vlax-release-object Self)
(vlax-release-object Fold)
(and (= "\\" (substr Path (strlen Path)))
(setq Path (substr Path 1 (1- (strlen Path)))))
)
)
Path
)
|
Modificato da - arri in data 12 maggio 2012 17:13:10 |
|
|
|
zenobio
Utente Medio
Regione: Veneto
Prov.: Venezia
Città: san michele al tagliamento
33 Messaggi |
Inserito il - 13 maggio 2012 : 10:20:52
|
grazie Arri
ho fatto vari tentativi dopo il tuo post ma senza successo, probabilmente c'è qualcos'altro che non mi gira in quella lisp ma riguardando le tue correzioni che mi hanno aperto la mente ho ripescato la lisp che avevi suggerito tu l'ho modificata aggiungendo le parti che mi permettono di settare la cartella e sono riuscito nel mio intento
adesso funziona. 
(defun c:WBKA ( / fla dat blk)
(prompt "\nEstrae tutti i blocchi presenti nel disegno.")
;______________________________________________________________________________
(if
(setq dir
(LM:DirDialog
(strcat
"Selezionare la cartella dove salvare i blocchi.\n"
)
nil 832
)
)
(setq dir (vl-string-translate "\\" "/" dir))
)
;______________________________________________________________________________
(setq fla T)
(while
(setq dat (tblnext "block" fla))
(setq blk (cdr (assoc 2 dat )))
(setq wbl(strcat dir (chr 92) blk))
(if (not (= (substr blk 1 1) "*"))
(command "_wblock" wbl blk))
(setq fla nil))
(princ dir)
(princ))
;______________________________________________________________________________
;;-------------------=={ Directory Dialog }==-----------------;;
;; ;;
;; Displays a dialog prompting the user to select a folder ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; msg - message to display at top of dialog ;;
;; dir - root directory (or nil) ;;
;; flag - bit coded flag specifying dialog display settings ;;
;;------------------------------------------------------------;;
;; Returns: Selected folder filepath, else nil ;;
;;------------------------------------------------------------;;
(defun LM:DirDialog ( msg dir flag / Shell HWND Fold Self Path ac )
(vl-load-com)
;; © Lee Mac 2010
(setq Shell (vla-getInterfaceObject (setq ac (vlax-get-acad-object)) "Shell.Application")
HWND (vl-catch-all-apply 'vla-get-HWND (list ac))
Fold (vlax-invoke-method Shell 'BrowseForFolder (if (vl-catch-all-error-p HWND) 0 HWND) msg flag dir))
(vlax-release-object Shell)
(if Fold
(progn
(setq Self (vlax-get-property Fold 'Self) Path (vlax-get-property Self 'Path))
(vlax-release-object Self)
(vlax-release-object Fold)
(and (= "\\" (substr Path (strlen Path)))
(setq Path (substr Path 1 (1- (strlen Path)))))
)
)
Path
)
(prompt "\nEstrae tutti i blocchi presenti nel disegno.")
(prompt "\nParte con WBKA.")
|
Modificato da - zenobio in data 13 maggio 2012 10:21:50 |
|
|
|
zenobio
Utente Medio
Regione: Veneto
Prov.: Venezia
Città: san michele al tagliamento
33 Messaggi |
Inserito il - 13 maggio 2012 : 19:41:56
|
preso da megalomania ho provato ad inserire una routine che mi salvasse in un file testo il nome dei blocchi
; Estrae tutti i blocchi presenti nel disegno : WBKA
(defun c:WBKA ( / fla dat blk)
;______________________________________________________________________________
(if
(setq dir
(LM:DirDialog
(strcat "Selezionare la cartella dove salvare i blocchi.\n")
nil 832))
(setq dir (vl-string-translate "\\" "/" dir)))
;______________________________________________________________________________
(setq fla T)
(while
(setq dat (tblnext "block" fla))
(setq blk (cdr (assoc 2 dat )))
(setq wbl (strcat dir (chr 92) blk))
(if (not (= (substr blk 1 1) "*"))
(command "_wblock" wbl "_Y" blk)
(command "_wblock" wbl blk))
(setq fla nil))
;(princ dir)
(princ blk)
(princ)
;______________________________________________________________________________
(setq fil (vl-directory-files dir "*.dwg"));imposto in fil la sita dei file dwg
(setq name (getvar "dwgname")); imposto in name il nome del file
(setq filename (strcat dir "/" name ".txt"));imposto in filname il nome del file
; da creare nella cartella
(princ filename);verifico se il nome è impostato correttamente
(princ)
(princ fil); verifico il contenuto di fil
(if fil
(progn
(setq itm 0)
(setq num (sslength fil))
(if (/= filename nil)
(progn
(setq fh (open filename "w"))
(while (< itm num)
(setq hnd (ssname fil itm))
(setq ent (entget hnd))
(setq stv (cdr (assoc 1 ent)))
(princ (strcat stv "\n") fh)
(setq itm (1+ itm))
); fine while
(close fh)
)
)
)
)
;______________________________________________________________________________
);fine defun
;;_________________________{ Directory Dialog }________________________________
;; Displays a dialog prompting the user to select a folder ;;
;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;; Arguments: ;;
;; msg - message to display at top of dialog ;;
;; dir - root directory (or nil) ;;
;; flag - bit coded flag specifying dialog display settings ;;
;; Returns: Selected folder filepath, else nil ;;
;______________________________________________________________________________
(defun LM:DirDialog ( msg dir flag / Shell HWND Fold Self Path ac )
(vl-load-com) ;; © Lee Mac 2010
(setq Shell (vla-getInterfaceObject (setq ac (vlax-get-acad-object)) "Shell.Application")
HWND (vl-catch-all-apply 'vla-get-HWND (list ac))
Fold (vlax-invoke-method Shell 'BrowseForFolder (if (vl-catch-all-error-p HWND) 0 HWND) msg flag dir))
(vlax-release-object Shell)
(if Fold
(progn
(setq Self (vlax-get-property Fold 'Self) Path (vlax-get-property Self 'Path))
(vlax-release-object Self)
(vlax-release-object Fold)
(and (= "\\" (substr Path (strlen Path)))
(setq Path (substr Path 1 (1- (strlen Path)))))))
Path
)
(prompt "\nEstrae tutti i blocchi presenti nel disegno.")
(prompt "\nParte con WBKA.")
ma mi da il seguente errore :
errore: tipo di argomento corrotto
(SSLENGTH FIL)
(SETQ NUM (SSLENGTH FIL))
(PROGN (SETQ ITM 0) (SETQ NUM (SSLENGTH FIL)) (IF (/= FILENAME nil) (PROGN (SETQ FH (OPEN FILENAME "w")) (WHILE (< ITM NUM) (................
cosa sbaglio
il princ mi visualizza questo
E:/Users/Zenobio/Desktop/Nuova cartella/1/FRONT-BACK-VEHICLES.dwg.txt(4DOOR15F.DWG PICKU14B.DWG STAWAGB.DWG STAWAGF.DWG)
che correttamente sono il percorso/file impostato e i file contenuti nella cartella (vedi fil)
p.s.: ho usato una routine che originariamente salva le righe di testo selezionate. (txtexprt.lsp) |
Modificato da - zenobio in data 13 maggio 2012 19:44:27 |
|
|
|
arri
Utente Master
Regione: Lombardia
14951 Messaggi |
Inserito il - 14 maggio 2012 : 01:43:01
|
Messaggio inserito da zenobio
(setq num (sslength fil))
(if (/= filename nil)
(progn
(setq fh (open filename "w"))
(while (< itm num)
(setq hnd (ssname fil itm))
(setq ent (entget hnd))
(setq stv (cdr (assoc 1 ent)))
(princ (strcat stv "\n") fh)
(setq itm (1+ itm))
); fine while
sostituisci con questa
(setq num (length fil))
(if (/= filename nil)
(progn
(setq fh (open filename "w"))
(while (< itm num)
(setq hnd (nth itm fil))
(princ (strcat hnd "\n") fh)
(setq itm (1+ itm))
); fine while
P.S.
prego  |
Modificato da - arri in data 14 maggio 2012 08:08:32 |
|
|
|
zenobio
Utente Medio
Regione: Veneto
Prov.: Venezia
Città: san michele al tagliamento
33 Messaggi |
Inserito il - 14 maggio 2012 : 07:04:02
|
grazie
funziona benissimo ora proverò a capire le differenze dei comandi.
ho notato che vai a letto tardi io invece mi alzo presto
 |
|
|
|
zenobio
Utente Medio
Regione: Veneto
Prov.: Venezia
Città: san michele al tagliamento
33 Messaggi |
Inserito il - 16 maggio 2012 : 08:07:31
|
Ciao
un'ultima cortesia come faccio ad unire la variabile "dir" con la variabile "fil" in modo che il file di testo contenga una lista di questo formato:
c:/miadir/miofile01
c:/miadir/miofile02
c:/miadir/miofile03
........
tra le altre cose ho provato con
(foreach fil dir
(setq file (strcat dir (chr 92) fil)))
ma mi da errore
|
Modificato da - zenobio in data 16 maggio 2012 08:08:09 |
|
|
|
arri
Utente Master
Regione: Lombardia
14951 Messaggi |
Inserito il - 16 maggio 2012 : 08:39:50
|
Messaggio inserito da zenobio
Ciao
un'ultima cortesia come faccio ad unire la variabile "dir" con la variabile "fil" in modo che il file di testo contenga una lista di questo formato:
c:/miadir/miofile01
c:/miadir/miofile02
c:/miadir/miofile03
........
tra le altre cose ho provato con
(foreach fil dir
(setq file (strcat dir (chr 92) fil)))
ma mi da errore
vedi la modifica in rosso
(defun c:WBKA ( / fla dat blk)
;______________________________________________________________________________
(if
(setq dir
(LM:DirDialog
(strcat "Selezionare la cartella dove salvare i blocchi.\n")
nil 832))
(setq dir (vl-string-translate "\\" "/" dir)))
;______________________________________________________________________________
(setq fla T)
(while
(setq dat (tblnext "block" fla))
(setq blk (cdr (assoc 2 dat )))
(setq wbl (strcat dir (chr 92) blk))
(if (not (= (substr blk 1 1) "*"))
(command "_wblock" wbl "_Y" blk)
(command "_wblock" wbl blk))
(setq fla nil))
;(princ dir)
(princ blk)
(princ)
;______________________________________________________________________________
(setq fil (vl-directory-files dir "*.dwg"));imposto in fil la sita dei file dwg
(setq name (getvar "dwgname")); imposto in name il nome del file
(setq filename (strcat dir "/" name ".txt"));imposto in filname il nome del file
; da creare nella cartella
(princ filename);verifico se il nome è impostato correttamente
(princ)
(princ fil); verifico il contenuto di fil
(if fil
(progn
(setq itm 0)
(setq num (length fil))
(if (/= filename nil)
(progn
(setq fh (open filename "w"))
(while (< itm num)
(setq hnd (nth itm fil))
(princ (strcat dir "/" hnd "\n") fh)
(setq itm (1+ itm))
); fine while
(close fh)
)
)
)
)
;______________________________________________________________________________
);fine defun
;;_________________________{ Directory Dialog }________________________________
;; Displays a dialog prompting the user to select a folder ;;
;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;; Arguments: ;;
;; msg - message to display at top of dialog ;;
;; dir - root directory (or nil) ;;
;; flag - bit coded flag specifying dialog display settings ;;
;; Returns: Selected folder filepath, else nil ;;
;______________________________________________________________________________
(defun LM:DirDialog ( msg dir flag / Shell HWND Fold Self Path ac )
(vl-load-com) ;; © Lee Mac 2010
(setq Shell (vla-getInterfaceObject (setq ac (vlax-get-acad-object)) "Shell.Application")
HWND (vl-catch-all-apply 'vla-get-HWND (list ac))
Fold (vlax-invoke-method Shell 'BrowseForFolder (if (vl-catch-all-error-p HWND) 0 HWND) msg flag dir))
(vlax-release-object Shell)
(if Fold
(progn
(setq Self (vlax-get-property Fold 'Self) Path (vlax-get-property Self 'Path))
(vlax-release-object Self)
(vlax-release-object Fold)
(and (= "\\" (substr Path (strlen Path)))
(setq Path (substr Path 1 (1- (strlen Path)))))))
Path
)
(prompt "\nEstrae tutti i blocchi presenti nel disegno.")
(prompt "\nParte con WBKA.")
P.S.
prego  |
Modificato da - arri in data 17 maggio 2012 13:27:04 |
|
|
|
zenobio
Utente Medio
Regione: Veneto
Prov.: Venezia
Città: san michele al tagliamento
33 Messaggi |
Inserito il - 17 maggio 2012 : 09:34:58
|
Scusa se ti ringrazio in ritardo adesso funziona come volevo.
|
Modificato da - zenobio in data 17 maggio 2012 10:03:49 |
|
|
|
zenobio
Utente Medio
Regione: Veneto
Prov.: Venezia
Città: san michele al tagliamento
33 Messaggi |
Inserito il - 17 maggio 2012 : 20:11:07
|
son ancora qua
c'è un comando tipo
(setq name (getvar "dwgname"))
(setq len (strlen name))
(setq name (substr name 1 (- len 4)))
per togliere le terminazioni .dwg dalla lista creata con
(setq file (vl-directory-files dir "*.dwg"))
ed avere una lista del tipo
miofile01
moifile02
.....
al posto di
miofile01.dwg
moifile02.dwg
....... |
|
|
|
Terminator
Utente Master
725 Messaggi |
Inserito il - 18 maggio 2012 : 11:52:38
|
(mapcar '(lambda (elem)(vl-filename-base elem)) file)
Dove file è la lista dei disegni.
PS: de nada 
|
Modificato da - Terminator in data 18 maggio 2012 15:53:08 |
|
|
|
zenobio
Utente Medio
Regione: Veneto
Prov.: Venezia
Città: san michele al tagliamento
33 Messaggi |
Inserito il - 18 maggio 2012 : 12:06:33
|
| Grazie Terminator |
|
|
| |
Discussione |
|
esportazione blocchi
