acad hispano
¿Quieres reaccionar a este mensaje? Regístrate en el foro con unos pocos clics o inicia sesión para continuar.

Listar Carpetas

2 participantes

Ir abajo

Listar Carpetas Empty Listar Carpetas

Mensaje por amc.dicsac Vie Mayo 27, 2016 11:26 am

Hola que tal, nesecito ayuda, quisiera saber si existe un lisp que me liste carpetas en una determinada ruta que se indica mendiante un setq, por ejemplo:

(setq "c:/Datos/")

---Datos
- Carpeta1
- Carpeta2
- Carpeta3

Gracias.
amc.dicsac
amc.dicsac

Mensajes : 83
Fecha de inscripción : 16/03/2016
Edad : 33
Localización : Lima - Perú

http://axprogramlisp.blogspot.pe/

Volver arriba Ir abajo

Listar Carpetas Empty Re: Listar Carpetas

Mensaje por nolo Vie Mayo 27, 2016 12:16 pm

Supongamos que asignaste
Código:
(setq path "c:/Datos/")

Obtienes una lista de los nombres de las carpetas principales de esa carpeta  con
Código:
(vl-loads-com)
(vl-directory-files path nil -1)
Del estilo de esto
Código:
("." ".." "carpeta1" "carpeta2" "carpeta3""etc")

Si quieres conseguir las subcarpetas, tendrás que hacer un bucle con la lista o una recursiva que recorra todo el árbol

Un saludo

nolo

Mensajes : 182
Fecha de inscripción : 17/03/2016

Volver arriba Ir abajo

Listar Carpetas Empty Re: Listar Carpetas

Mensaje por amc.dicsac Vie Mayo 27, 2016 12:19 pm

Hola nolo gracias, me supongo que poara eliminar esos puntitos que no se que pueden significar [.] [..] bastaria con esto

Código:
(defun Listado_Folder ( ruta / directorio extraer )
(vl-load-com)
 (setq directorio (vl-directory-files ruta nil -1))
  (setq extraer (cddr directorio))
    )
amc.dicsac
amc.dicsac

Mensajes : 83
Fecha de inscripción : 16/03/2016
Edad : 33
Localización : Lima - Perú

http://axprogramlisp.blogspot.pe/

Volver arriba Ir abajo

Listar Carpetas Empty Re: Listar Carpetas

Mensaje por nolo Vie Mayo 27, 2016 1:14 pm

Bien, pero yo lo hacía un poco mas largo, así
Código:
(vl-remove-if '(lambda(a) (member a '( "." ".."))) (vl-directory-files carpeta nil -1))

Mi manía de lambda

Un saludo

nolo

Mensajes : 182
Fecha de inscripción : 17/03/2016

Volver arriba Ir abajo

Listar Carpetas Empty Re: Listar Carpetas

Mensaje por amc.dicsac Vie Mayo 27, 2016 5:08 pm

Hola nolo disculpa no se si me podrias ayudas con mi dcl, no logro hacer que en mi list_box me aparescan la lista de bloques.

¡https://www.dropbox.com/sh/ftc1xyihyige1bo/AABcoNS1uwRdZLg-_KXPs9KMa?dl=0
amc.dicsac
amc.dicsac

Mensajes : 83
Fecha de inscripción : 16/03/2016
Edad : 33
Localización : Lima - Perú

http://axprogramlisp.blogspot.pe/

Volver arriba Ir abajo

Listar Carpetas Empty Re: Listar Carpetas

Mensaje por nolo Sáb Mayo 28, 2016 4:35 am

Si no te lo ha mirado alguien para el lunes, te lo miro yo que ando con un fin de semana movidito...
Un saludo

nolo

Mensajes : 182
Fecha de inscripción : 17/03/2016

Volver arriba Ir abajo

Listar Carpetas Empty Re: Listar Carpetas

Mensaje por nolo Dom Mayo 29, 2016 5:06 pm

Parece que a tu código le falta algo pero te lo propongo resolver con un bucle que es como lo suelo hace yo.
Igual hay otra forma pero ya me acostumbré a lo del bucle.
Código:
(defun c:L44 ( / crea-dcl _ax:start Listado_Folder  Get_Lista_Bloques ;; funciones usadas    
 dcl_id  dcl_tem archdcl *screenpointLCAPAS* n1 n2) ;; variables de la rutina

;;----1º-- definir Lista maestra de nuevas funciones -----------------------

(defun crea-dcl( )
(write-line
"ListaFolder: dialog { label = \"Listado de carpetas:\"; width=50;
        :popup_list { key =\"key_folder\"; width=30; }
 spacer_1;
        :list_box { key = \"key_dwg\"; width=30; }
        : button { label = \" &Cancelar \"; mnemonic = \"C\"; key = \"cancel\"; fixed_width = true; is_cancel = true;}
}"(setq dcl_tem (vl-filename-mktemp "Dlg.dcl")
 ArchDCL (open dcl_tem "w")
 )
)
(close ArchDCL)
)

(defun _ax:start ( key lst )
   (start_list key)
   (mapcar 'add_list lst)
   (end_list)
   lst
)
  
;; Listado de carpetas
(defun Listado_Folder ( ruta / directorio extraer )
(vl-load-com)
(setq directorio (vl-directory-files ruta nil -1))
(setq extraer (cddr directorio)))

;;Lista de dibujos de un directorio
(defun Get_Lista_Bloques (Dir / )
  (if (setq LisBlk (vl-directory-files Dir "*.dwg" 1))
      (setq lisBlk (mapcar 'vl-filename-base lisBlk)
            lisBlk (acad_strlsort lisBlk))
      );c.if
    );c.defun


;;----------- 2º asignar datos a las variables por defecto -------------

(setq Carpeta_alumbrado "1-Alimentadores");;; Nombre de la carpeta con bloques

(setq Carpeta_dwg "C:/Bloques/");;; Ruta donde se encuentran las carpetas

;;; Listar todas las carpetas que existe en esa ruta
(setq Carpeta_lista (Listado_Folder Carpeta_dwg))
(setq Carpeta_actual Carpeta_alumbrado)

;;; -------- 3º Programar la rutina -----------------

;;; crear el dcl
(if (and dcl_temp (findfile dcl_tem))(vl-file-delete dcl_tem))
(crea-dcl)

(setq dcl_id (load_dialog dcl_tem);;;;"C:/Program Files/ListaFolder.dcl"))
 ddiag 22 ) ;;; cualquier valor mayor del que hace salir a la rutina


(while (> ddiag 2) ;; bucle
;;;;;; que es esto - >>>"" (cond (*screenpointLCAPAS*) ('(-1 -1)))));;no se que es *screenpointLCAPAS*, función ????
(if (not (new_dialog "ListaFolder" dcl_id ))
 (progn (alert "\n**Error archivo no encontrado**")(exit))
)
;;;; actualizar lista de datos
 (setq Path (strcat Carpeta_dwg Carpeta_actual))
 (setq Listado_dwg (Get_Lista_Bloques Path))

;;rellenar los valores del dcl
 (_ax:start "key_folder" Carpeta_lista)
 (_ax:start "key_dwg" Listado_dwg)

;;  assignar acciones del dcl
 (action_tile "cancel" "(setq *screenpointLCAPAS* (done_dialog 1))");; aqui *screenpointLCAPAS* parece una variable
 (action_tile "key_folder" (strcat "(setq n1 (atoi (get_tile \"key_folder\")) )(setq Carpeta_actual (nth n1 Carpeta_lista))"
 ;; para dejar siembre el primer valor de carpeta_lista sea carpeta_actual
 "(setq carpeta_lista (cons carpeta_actual (vl-remove carpeta_actual carpeta_lista)))"
 "(done_dialog 3)"))
 (action_tile "key_dwg" "(setq n2 (atoi (get_tile \"key_dwg\"))) (done_dialog 2)")

 (setq ddiag (start_dialog)) ;; activar dcl

);; final bucle

(if (= ddiag 1)
 (prompt "\nPrograma Cancelado...")
 (print (nth n2 Listado_dwg))
)

(unload_dialog dcl_id)

(vl-file-delete dcl_tem)
(princ "\nTerminado..")
(princ)
)

Lo resuelvo creando un temporal por comodidad, pero igual te funcionará le quitas la rutina de crear el dcl.

Un saludo

nolo

Mensajes : 182
Fecha de inscripción : 17/03/2016

Volver arriba Ir abajo

Listar Carpetas Empty Re: Listar Carpetas

Mensaje por amc.dicsac Lun Mayo 30, 2016 2:17 pm

Hola nolo que tal gracias por tu respuesta, modifique algunas cosas del lisp que me mandaste, pero ahora surge un error cuando selecciono la carpeta "2-Tomacorrientes" y selecciono un bloque para inserta resulta que me inserta otro bloque que pertence a la carpeta "1-Alimentadores",  creo que por mas que selecione otra carpeta este mismo me va a inserta los bloques que estan en la carpeta "1-Alimentadores" y no se porque pasa prodria ser que esta leyendo mal los datos de una lista ????  

Código:
(defun c:L44 ( / dcl_id )

(defun crea-dcl( )
(write-line
"ListaFolder: dialog { label = "Listado de carpetas:"; width=50;
        :popup_list { key ="key_folder"; width=30; }
 spacer_1;
        :list_box { key = "key_dwg"; width=30; }
        : button { label = " &Cancelar "; mnemonic = "C"; key = "cancel"; fixed_width = true; is_cancel = true;}
        : button { label = " &Insertar"; mnemonic = "I"; key = "key_in"; fixed_width = true; }
}"(setq dcl_tem (vl-filename-mktemp "Dlg.dcl")
 ArchDCL (open dcl_tem "w")
 )
)
(close ArchDCL)
)

;;Carpetas por defecto
(if (null *Carpeta_alumbrado*) (setq *Carpeta_alumbrado* "0"))
(if (null *Carpeta_dwg*) (setq *Carpeta_dwg* "0"))

;;; Nombre de la carpeta con bloques
(setq Carpeta_alumbrado "1-Alimentadores")

;;; Ruta donde se encuentran las carpetas  
(setq Carpeta_dwg "C:/Bloques/")

;;; crear el dcl
(if (and dcl_temp (findfile dcl_tem))(vl-file-delete dcl_tem))
(crea-dcl)

(setq dcl_id (load_dialog dcl_tem);;;;"C:/Program Files/ListaFolder.dcl"))
 ddiag 22 ) ;;; cualquier valor mayor del que hace salir a la rutina

(if (not (new_dialog "ListaFolder" dcl_id ))
 (progn (alert "\n**Error archivo no encontrado**")(exit))
)

;;Listar las carpetas que estan dentrl de c:/Bloques/
(setq Carpeta_lista (Listado_Folder Carpeta_dwg))
  
;;Extraer la carpeta actual 1-Alimentadores
(setq Carpeta_actual Carpeta_alumbrado)

;;Listado de bloque de carpeta 1-Alimentadores
(setq Path (strcat Carpeta_dwg Carpeta_actual))
(setq Listado_dwg (Get_Lista_Bloques Path))

(if (or(null Listado1)(null (listp Listado1))) (setq Listado1 (Get_Lista_Bloques Path)) )
(setq n2 (nth (atoi *Carpeta_dwg*) Listado1))

;;rellenar los valores del dcl
(_ax:start "key_folder" Carpeta_lista)
(_ax:start "key_dwg" Listado1)

;;  assignar acciones del dcl

;; Accion para carpetas
(set_tile "key_folder" *Carpeta_alumbrado*)
(action_tile "key_folder" "(_ax:start "key_dwg" (setq key_folder (Get_Lista_Bloques (strcat Carpeta_dwg (setq n1 (nth (atoi (setq *Carpeta_alumbrado* $value)) Carpeta_lista))))))")
;; Accion para archivos
(set_tile "key_dwg" *Carpeta_dwg*)                                  
(action_tile "key_dwg" "(setq n2 (nth (atoi (setq *Carpeta_dwg* $value)) Listado1)) ")

(action_tile "cancel" "(setq *screenpointLCAPAS* (done_dialog 1))")
(action_tile "key_in" "(setq **screenpointLCAPAS* (done_dialog 2))")
(setq ddiag (start_dialog))
(princ)
(if (= ddiag 1) (prompt "\nPrograma Cancelado..."))
(if (= ddiag 2) (insertalo))
(unload_dialog dcl_id)
(vl-file-delete dcl_tem)
(princ "\nTerminado..")
(PRINC))

(defun insertalo ( )
(setvar "cmdecho" 0)
(setq msxb (strcat  "\n>> Punto de Inserción del bloque [ " n2 " ]: "))
(princ msxb)
(command "._insert" n2 "_s" "1")
(while (= (logand (getvar "cmdactive") 1) 1)
 (command pause)
 )
(vl-cmdf "explode" "last")
(setvar "cmdecho" 1)
(princ))

;;-----------------Lista maestra------------------------
(defun _ax:start ( key lst )
   (start_list key)
   (mapcar 'add_list lst)
   (end_list)
   lst
)
  
;; Listado de carpetas
(defun Listado_Folder ( ruta / directorio extraer )
(vl-load-com)
(setq directorio (vl-directory-files ruta nil -1))
(setq extraer (cddr directorio)))

;;Lista de dibujos de un directorio
(defun Get_Lista_Bloques (Dir / )
  (if (setq LisBlk (vl-directory-files Dir "*.dwg" 1))
      (setq lisBlk (mapcar 'vl-filename-base lisBlk)
            lisBlk (acad_strlsort lisBlk))
      );c.if
    );c.defun
amc.dicsac
amc.dicsac

Mensajes : 83
Fecha de inscripción : 16/03/2016
Edad : 33
Localización : Lima - Perú

http://axprogramlisp.blogspot.pe/

Volver arriba Ir abajo

Listar Carpetas Empty Re: Listar Carpetas

Mensaje por nolo Lun Mayo 30, 2016 4:06 pm

Sinceramente, no entiendo nada de lo que estas tratando de hacer, a ver, unos comentarios:

En los programas hay que seguir un orden para que cuando parece un fallo se pueda buscar el error.
Habitualmente, se definen primero las sub-rutinas, luego los valores por defecto a la entrada al núcleo de cálculo (en tu caso la búsqueda de archivo mediante el dcl). Finalmente, tras el núcleo de cálculo, las salidas (en tu caso insertar el bloque).

Los datos-variables globales, hay bastantes programadores que utilizan el convenio de ponerlos entre * ¿No se si es tu caso? Bueno, pues el sitio de tomarlos es antes del núcleo del dcl y para dejarlos, al final del dcl. No en el apartado del dcl.

El apartado del dcl, tiene que retroalimentase a si mismo con los datos que seleccionas y el contenido de las carpetas. No puedes hacer fija una variable de lo que buscas porque te da siempre la misma solución que es lo que te esta pasando.

No se como funciona el $value en tu caso, yo solo lo he utilizado para pasar de celda en celda de las entradas, e igual me pasa con rellenar una lista del dcl desde una respuesta, no me creo que funcione bien. Por eso utilizo el get_tile y un bucle que solo sale cuando done_dialog es mayor que una cantidad. También creo que el set_tile no se puede utilizar ni en los popup_list ni en los list_box, si no que hay que ordenar la lista que le suministras para que el dato que aparezca primero sea el que deseas.

Esta claro que si no sigues ninguno de los principios de la primera rutina, no te puedo ayudar a cambiarla ..

Un saludo

Código:
(defun c:L44 ( / );;;dcl_id crea-dcl _ax:start  Listado_Folder Get_Lista_Bloques ;;  subrrutinas
 ;;; *Carpeta_alumbrado* *Carpeta_dwg* )
;;;;;;;;;;;;;;; primero las subrrutinas
(defun crea-dcl( )
(write-line
"ListaFolder: dialog { label = \"Listado de carpetas:\"; width=50;
        :popup_list { key =\"key_folder\"; width=30; }
 spacer_1;
        :list_box { key = \"key_dwg\"; width=30; }
        : button { label = \" &Cancelar \"; mnemonic = \"C\"; key = \"cancel\"; fixed_width = true; is_cancel = true;}
}"(setq dcl_tem (vl-filename-mktemp "Dlg.dcl")
 ArchDCL (open dcl_tem "w")
 )
)
(close ArchDCL)
)

;;-----------------Lista maestra------------------------
(defun _ax:start ( key lst )
   (start_list key)
   (mapcar 'add_list lst)
   (end_list)
   lst
)
  
;; Listado de carpetas
(defun Listado_Folder ( ruta / directorio extraer )
(vl-load-com)
(setq directorio (vl-directory-files ruta nil -1))
(setq extraer (cddr directorio)))

;;Lista de dibujos de un directorio
(defun Get_Lista_Bloques (Dir / )
  (if (setq LisBlk (vl-directory-files Dir "*.dwg" 1))
      (setq lisBlk (mapcar 'vl-filename-base lisBlk)
            lisBlk (acad_strlsort lisBlk))
      );c.if
    );c.def

(defun insertalo (n2)
(setvar "cmdecho" 0)
(setq msxb (strcat  "\n>> Punto de Inserción del bloque [ " n2 " ]: "))
(princ msxb)
(command "._insert" n2 "_s" "1")
(while (= (logand (getvar "cmdactive") 1) 1)
 (command pause)
 )
(vl-cmdf "explode" "last")
(setvar "cmdecho" 1)
(princ))



;;;;;;;;;;;;; fin definición de las subrrutinas

;;;;;;;;;;;;; asignar valores por defecto

;;Carpetas por defecto que no tinen nada que ver con larutina ?????
(if (null *Carpeta_alumbrado*) (setq *Carpeta_alumbrado* "0"))
(if (null *Carpeta_dwg*) (setq *Carpeta_dwg* "0"))

;;; Nombre de la carpeta con bloques
(setq Carpeta_alumbrado "1-Alimentadores")

;;; Ruta donde se encuentran las carpetas  
(setq Carpeta_dwg "C:/Bloques/")

;;Listar las carpetas que estan dentro de c:/Bloques/
(setq Carpeta_lista (Listado_Folder Carpeta_dwg))
  
;;Extraer la carpeta actual 1-Alimentadores
(setq Carpeta_actual Carpeta_alumbrado)
;;Listado de bloque de carpeta 1-Alimentadores
(setq Path (strcat Carpeta_dwg Carpeta_actual))

(setq Listado1 (Get_Lista_Bloques Path))


;;; crear el dcl
(if (and dcl_temp (findfile dcl_tem))(vl-file-delete dcl_tem))
(crea-dcl)

(setq dcl_id (load_dialog dcl_tem);;;;"C:/Program Files/ListaFolder.dcl")) )

(if (not (new_dialog "ListaFolder" dcl_id ))
 (progn (alert "\n**Error archivo no encontrado**")(exit))
)

;;; todo esto sobra
;; (setq Listado_dwg (Get_Lista_Bloques Path)) ;;;;SOBRA
;;(if (or(null Listado1)(null (listp Listado1))) (setq Listado1 (Get_Lista_Bloques Path)) )
;;(setq n2 (nth (atoi *Carpeta_dwg*) Listado1))


;;rellenar los valores del dcl
(_ax:start "key_folder" Carpeta_lista)
(_ax:start "key_dwg" Listado1)

;;; esto remite a variables globales que no se a que viene ni en este sitio
;;(set_tile "key_folder" *Carpeta_alumbrado*)
;;(set_tile "key_dwg" *Carpeta_dwg*)


;;  assignar acciones del dcl

;; Accion para carpetas
(action_tile "key_folder" (strcat
 "(_ax:start \"key_dwg\" (setq Listado1 (Get_Lista_Bloques(strcat Carpeta_dwg  (nth (atoi (get_tile \"key_folder\")) Carpeta_lista)))))"
 "(_ax:start \"key_folder\"(setq Carpeta_actual (nth (atoi (get_tile \"key_folder\")) Carpeta_lista)"
 "carpeta_lista (cons carpeta_actual (vl-remove carpeta_actual carpeta_lista)) ))"
 ))


;;;;;;;;;;, TODO ESTO NO LO ENTIENDO NO SE A QUE VIENE EL $VALUE AQUI
;; "(_ax:start "key_dwg" (setq key_folder
;; (Get_Lista_Bloques (strcat Carpeta_dwg (setq n1 (nth (atoi (setq *Carpeta_alumbrado* $value)) Carpeta_lista))))))")
;;

;; Accion para archivos
(action_tile "key_dwg" "(setq n2 (nth (atoi (get_tile \"key_dwg\" )) Listado1)) (done_dialog 3) ")

(action_tile "cancel" "(setq *screenpointLCAPAS* (done_dialog 1))")
;;;;;;;(action_tile "key_in" "(setq **screenpointLCAPAS* (done_dialog 2))");;; de que va esto ??
 
(setq ddiag (start_dialog))


(vl-file-delete dcl_tem)

;;;(princ)
(if (= ddiag 1) (prompt "\nPrograma Cancelado..."))
(if (= ddiag 3) (insertalo (strcat Carpeta_dwg n2) ))
(unload_dialog dcl_id)

(princ "\nTerminado..")
(PRINC))

nolo

Mensajes : 182
Fecha de inscripción : 17/03/2016

Volver arriba Ir abajo

Listar Carpetas Empty Re: Listar Carpetas

Mensaje por Contenido patrocinado


Contenido patrocinado


Volver arriba Ir abajo

Volver arriba


 
Permisos de este foro:
No puedes responder a temas en este foro.