Copiando Archivos

Uuuuff después de meses y meses (año y medio masmenos) de no tener una entrada en el blog, coloco ahora una que hubiera resultado muy practica para una entrega de proyecto que tuvimos hace unos días.


En la entrega en cuestión, nos era indispensable copiar unos archivos con extensión dwf, eran muchos proyectos, cada uno en su carpeta y necesitábamos conservar esta estructura de los directorios/carpetas. 


Hace ya tiempo genere una función en lisp para hacer el trabajo, pero también recordé el comando xcopy que hace la misma función, pero mucho mas rápida por ser una herramienta del sistema operativo, ademas que nos permite copiar archivos después de una fecha especifica y algunas monadas mas, pongo aquí como utilizarla:

• Iniciamos la consola de comandos de Windows, presionando la tecla Windows (esta al lado izquierdo del teclado, casi junto a la barra espaciadora), manteniendola presionada, presionemos la tecla R (Windows+R).

• En la ventana Ejecutar, tecleemos cmd y presionemos Enter
• Se abre una ventana con la consola de comandos del Sistema Operativo en la cual podemos ingresar el comando XCopy

• El comando Xcopy acepta los siguientes argumentos: 

          “dirección a copiar” “directorio destino” parametros

Se deberá reemplazar “dirección a copiar” por la carpeta que necesitamos, por ejemplo:

c:\Mis Proyectos\2011\Casa0521\*.dwg 

y “directorio destino” por la dirección en donde queremos los archivos, por ejemplo C:\Temp\

En parametros podemos utilizar los siguientes:

/s = Copiara todas las subcarpetas, excepto las vacias.

/d = Copiara los archivos a partir de una fecha especifica (mes-dia-año), sino se especifica y los archivos ya existen en el directorio destino, solo se copiaran los archivos que se hayan modificado.

/y = No es necesario confirmar la copia de cada archivo, esto solo en caso que existan los archivos

/c = Si ocurre un error, el programa continua

Notas:

Las rutas se deberán escribir en comillas si estas tienen espacios. Si queremos pegar la ruta, debemos usar el mouse, ya que la ventana del DOS no acepta la combinación de teclas Control+V.

Entonces, el texto a ingresar en la linea de comandos seria como sigue:

xcopy "c:\Mis Proyectos\2011\Casa0521\*.dwf" c:\temp /s /c /y /d:09-20-2011

Con lo cual se copiaran todos los archivos dwg, de la carpeta especificada a la destino, siempre y cuando se hayan modificado después del 20 de septiembre de 2011

Con este comando pueden copiar todos los archivos, o como en este caso solo copiar el tipo de archivo que nos interese, y despues de una fecha especifica, util para hacer respaldos, o como en nuestro caso para entregar los archivos que necesitamos sin tener que copiar los archivos o carpetas individualmente

Rota Dimensiones

;;;---------------------------------------------------------------------------------------------
;;;RotDIM
;;;Mcommands 2010, Guadalajara, Jalisco México
;;;Autor: Marco Antonio Jacinto Pérez
;;;---------------------------------------------------------------------------------------------
;;;El comando RotDim permite cambiar el UCS de las cotas para que coincidan con el UCS
;;;actual y evita asi que aparezcan giradas.
;;;---------------------------------------------------------------------------------------------
(DEFUN c:rotdim (/ ss ent ANG0 )
(OR MU:THISDRAWING
(SETQ MU:THISDRAWING (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT)))
)
;;;Si ya existe una marca para undo se termina, ya que en ocasiones el crear
;;;una nueva marca puede hacer que AutoCAD se termine abruptamente
(IF (= 8 (LOGAND 8 (GETVAR "UNDOCTL")))
(vla-EndUndoMark MU:THISDRAWING)
)
(vla-StartUndoMark MU:THISDRAWING)
(princ
"\n Selecciona las cotas a orientar segun el UCS actual:"
)
(SETQ ss (SSGET '((0 . "DIMENSION")))
;;; Se trasladan los puntos 0,0 y 1,0 al Ucs Actual, y se obtiene despues el
;;; angulo que forman entre ellas
ang0 (ANGLE (TRANS '(0 0) 0 1) (TRANS '(1 0) 0 1))
)
(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(VLA-PUT-ROTATION
(VLAX-ENAME->VLA-OBJECT ent)
ang0
)
)
(vla-EndUndoMark MU:THISDRAWING)
(PRINC)
)

Esta función crea una polilínea al interior de un área cerrada, al crearla la coloca en el layer VALORIZA MURO y la hace el doble de ancho que la separación entre contornos, por defecto el comando apagara todos los layers a excepción de los que contengan la palabra Muro y Columna.

(DEFUN c:ofin (/ ANCHOPOLILINEA  BO
DISTANCIAOFFSET  ELAST  OBJ  OLDLAY
PLINENUEVA COLORLAY  NOMBRELAY PTIN
)
;;;Se establece un inicio de uno, asi al desacher el comando se
;;;regresara al estado del dibujo antes de comenzar ofin
(COMMAND "_undo" "_be")
;;;Se graba el layer actual
(SETQ oldLay (GETVAR "clayer"))
;;;Se establece el nombre que tendra el nuevo layer
(SETQ NombreLay "VALORIZA MURO")
;;;El color del nuevo layer
(SETQ ColorLay 28)
;;;La separacion de la nueva polilinea
(SETQ DistanciaOffset 0.025)
;;;El ancho de la nueva polilinea, se considera que esta
;;;sera el doble de la separacion, para no dejar ningun
;;;ajuste
(SETQ AnchoPolilinea (* DistanciaOffset 2))
;;;Se apaga el eco de comandos, con esto no se vera el
;;;proceso de ninguna de las llamadas a la funcion
;;;command
(SETVAR "cmdecho" 0)
;;;si no existe el layer nuevo
(OR (TBLSEARCH "layer" NombreLay)
;;;se crea el nuevo layer
(COMMAND "_-layer" "_new" NombreLay "_color" ColorLay "" "")
)
;;;se establece el nuevo layer como el actual
(SETVAR "clayer" NombreLay)
;;;Se apagan todos los layers menos el actual, los muros y columnas
(command "_-layer" "_off" "*" "_no" "on" "*MURO*,*COLUMNA*" "")
;;;mientras exista ptin, se creara la polilinea interior
(SETQ ptin T);_con este valor se entra al ciclo
(WHILE ptin
(IF (AND (SETQ ptin (GETPOINT "\n Especifica un punto interno: "))
(SETQ elast (ENTLAST));_Se graba la ultima entidad 
(SETQ bo (BPOLY ptin));_Se graba el contorno creado
(/= elast bo);_Se compara la ultima entidad y el nuevo contorno
)
(PROGN
;;;Se crea la polilinea nueva al interior del contorno creado.
(COMMAND "_offset" DistanciaOffset bo ptin "")
(AND
;;;Se obtiene la nueva polilinea para compararla con el contorno
(SETQ PlineNueva (ENTLAST))
(/= PlineNueva bo)
;;;Se cambia el ancho de la polilinea al valor establecido
(VLA-PUT-CONSTANTWIDTH
(SETQ obj (VLAX-ENAME->VLA-OBJECT PlineNueva))
AnchoPolilinea
)
)
;;;Se borra el contorno creado
(AND bo (ENTDEL bo))
;;;Se manda la polilinea nueva al fondo
(COMMAND "_draworder" PlineNueva "" "_back")
)
)
)
;;;Se regresa al estado anterior de layers
(command "layerp")
;;;Se restaura el layer original
(SETVAR "clayer" oldLay)
;;;Se cierra el undo
(COMMAND "_undo" "_end")
(PRINC)
) 

Renombra Bloque

;;;El comando chBlock permite cambiar el nombre de cualquier bloque que se seleccione en pantalla, en caso de
;;;ya existir el bloqe el programa lo indica
;;;Autor: Marco Jacinto
;;;Puerto Vallarta Jalisco
(defun c:chblock (/ block ent newblock obj oldname)
(setq *adoc* (vla-get-activedocument(vlax-get-acad-object))
*blocks* (vla-get-blocks *adoc*)
)
(while (null obj)
(setq ent (entsel "\n Selecciona un bloque: "))
(if (and ent
(=(cdr(assoc 0 (entget (car ent))))"INSERT")
)
(progn
(and(setq newblock (getstring "\n Nuevo nombre para el bloque: "))
(/= newblock "")
(setq oldname (cdr(assoc 2 (entget (car ent))))
obj (vlax-ename->vla-Object (car ent)))
)
(if (vl-catch-all-error-p
(vl-catch-all-apply
'vla-item (list *blocks* NewBlock)
)
)
(progn
(vla-startUndoMark *adoc*)
(vla-put-name
(vla-item *blocks* oldName)
newblock
)
(mapcar 'princ (list "\n Bloque " oldname "renombrado a " newBlock"."))
(vla-EndUndoMark *adoc*)
)
(princ "\n El bloque ya existe, intenta, con otro nombre.")
)
)
(princ "\n No seleccionaste un bloque, intenta de nuevo.")
)
)
(princ)
)

Coloca la fecha en un texto

Con este codigo, el colocar la fecha en cualquier texto (Mtext o Dtext) o atributo es tan facil como seleccionarlo y listo, la fecha aparece magicamente.

(defun c:FechaActual (/ fecha nuevaFecha)
(SETQ FECHA (RTOS (GETVAR "CDATE")))
(SETQ AÑO (SUBSTR FECHA 1 4)
DIA (SUBSTR FECHA 7 2)
MES (NTH (1- (ATOI (SUBSTR FECHA 5 2)))
'("ENERO" "FEBRERO" "MARZO" "ABRIL" "MAYO" "JUNIO" "JULIO"
"AGOSTO" "SEPTIEMBRE" "OCTUBRE" "NOVIEMBRE" "DICIEMBRE"))
)
(SETQ NUEVAFECHA (STRCAT DIA " " MES " " AÑO))
(if (setq ent (nentsel))
(progn
(setq Obj (vlax-ename->Vla-Object (car ent)))
(vla-Put-TextString obj NuevaFecha)
)
)
(princ)
)

Contador de bloques

;;;---------------------------------------------------------------------------------------------------------------------
;;;CuentaBloques
;;;Mcommands 2009, Guadalajara, Jalisco México
;;;Autor Marco Antonio Jacinto Pérez
;;;---------------------------------------------------------------------------------------------------------------------
;;;Esta rutina obtendra los bloques por medio de una seleccion en pantalla,
;;;o automaticamente del Espacio Modelo o Papel para despues contarlos
;;;y crear una tabla con las cantidades y una insercion del mismo.
;;;---------------------------------------------------------------------------------------------------------------------

(vl-load-com)

(defun AddTextStyle
(TxtStyleName Font doc / *Textstyles* NewStyle)
(and
(setq *Textstyles*
(vla-get-TextStyles
doc
)
)
(not (collection-item-p *Textstyles* TxtStyleName))
(setq NewStyle (vla-add *Textstyles* TxtStyleName))
(vla-setFont NewStyle Font :vlax-false :vlax-false 0 0)
)
NewStyle
)


;;;----------------------------------------------;;;
;;;This function will pass a function to each ;;;
;;;element of a selection set ;;;
;;;----------------------------------------------;;;

(defun for-sset (sset f / n)
(if (= 'PICKSET (type sset)) ; _this will chek if the arguments is
; a
; selection
; set
(repeat (progn (setq n -1) (sslength sset))
(f (ssname sset (setq n (1+ n))))
)
)
)
;;;----------------------------------------------;;;

(defun collection-item-p (collection Item)
(cond ((vl-catch-all-error-p
(vl-catch-all-apply 'vla-item (list Collection Item))
)
nil
)
(t (vla-item Collection Item))
)
)

(defun list->variantArray (ptsList / arraySpace sArray)
; _ allocate space for an
; array of 2d points
; stored as
; doubles
(setq arraySpace
(vlax-make-safearray
vlax-vbdouble ;_ element type
(cons 0 (- (length ptsList) 1)) ;_ array dimension
)
)
(setq sArray (vlax-safearray-fill arraySpace ptsList))
; _ return array
; variant
(vlax-make-variant sArray)
)


(defun NameUnnamedUcs
(*adoc* UcsName / *UCS* Origin XAxisPoint YAxisPoint)
(if (= (getvar "WORLDUCS") 0) ;If UCS Difers from world then
(progn
(Setq *UCS* (vla-get-UserCoordinateSystems *adoc*)
Origin (getvar "UCSORG")
XAxisPoint (mapcar '(lambda (pt1 pt2) (+ pt1 pt2))
Origin
(getvar "UCSXDIR")
)
YAxisPoint (mapcar '(lambda (pt1 pt2) (+ pt1 pt2))
Origin
(getvar "UCSyDIR")
)
)
(vla-add *Ucs*
(list->variantArray Origin)
(list->variantArray XAxisPoint)
(list->variantArray YAxisPoint)
UcsName
)
)
)
)

(defun GetBlocks (space /)
(cond ((= (Type Space) 'STR)
(vlax-for obj (vla-get-block
(vla-item *layouts*
space
)
)
(bkobj obj)
)
)
((= (Type Space) 'PICKSET) ;(setq Space ss)
(for-sset Space
(lambda (ename / obj)
(setq obj (vlax-ename->vla-object ename))
(bkobj obj)
)
)
)
)
BkCountLst
)

(defun bkObj (obj / BkName)
(cond ((/= (vla-get-ObjectName obj) "AcDbBlockReference"))
((and
(setq BkName (vla-get-effectiveName obj))
(assoc BkName BkCountLst)
)
(setq BkCountLst
(subst (cons BkName (1+ (cdr (assoc BkName BkCountLst))))
(assoc BkName BkCountLst)
BkCountLst
)
)
)
(T
(setq BkCountLst
(cons (cons BkName 1) BkCountLst)
)
)
)
)


(Defun c:CuentaBloques (/ *acad* *adoc* *Layouts*
BkCountLst SpaceBkCt ptt *tabla*
Table1 *BLOCKS* CTROW ROW
*TABLESTYLE* CTC COL_CT
LayName NwUcs ss
)

(setq *acad* (vlax-get-acad-object)
*adoc* (vla-get-activedocument *acad*)
*Layouts* (vla-get-Layouts *adoc*)
*blocks* (vla-get-Blocks *adoc*)
)
(vla-startundomark *adoc*)
(or (setq NwUcs (collection-item-p
(vla-get-UserCoordinateSystems *adoc*)
"BTUcs"
)
)
)

(initget "Seleccion EspacioModelo espacioPapel Ambos")
(setq SpaceBkCt
(GetKword
"\n Contar bloques en [/EspacioModelo/espacioPapel/Ambos]"
)
)
(cond
((or (= SpaceBkCt "Seleccion") (= SpaceBkCt nil))
(setq SpaceBkCt "Seleccion")
(while (null ss)
(setq ss (ssget '((0 . "INSERT"))))
)
(princ "\n Obteniendo los bloques en la selección...")
(GetBlocks ss)
)
((= SpaceBkCt "EspacioModelo")
(setq SpaceBkCt "EspacioModelo")
(princ "\n Obteniendo bloques en el Espacio modelo...")
(GetBlocks "Model")
)
((= SpaceBkCt "espacioPapel")
(initget "Todos Escribir Actual")
(setq GetPs
(GetKword
"\n Contar bloques en el layout [/Escribir nombre/Todos]: "
)
)
(cond
((or (= GetPs nil) (= GetPs "Actual"))
(princ "\n Obteniendo los bloques en el layout actual...")
(GetBlocks (getvar "ctab"))
(setq SpaceBkCt "Layout actual")
)
((= GetPs "Todos")
(princ "\n Obteniendo bloques en todos los layouts...")
(setq Layouts (layoutlist))
(foreach lay layouts
(GetBlocks lay)
)
(setq SpaceBkCt "todos los Layouts")
)
(t
(while (not (member LayName (mapcar 'strcase (layoutlist))))
(setq LayName (strcase (getString "\n Type layout name: " T)))
)
(mapcar 'princ
(list "\n Obteniendo bloques en el layout " LayName "...")
)
(GetBlocks LayName)
(setq SpaceBkCt (strcat "Layout " LayName))
)
)
)
(t
(princ "\n Obteniendo bloques en espacio Modelo y en espacio Papel...")
(setq Layouts (cons "Model" (layoutlist)))
(foreach lay layouts
(GetBlocks lay)
)
)
)
(if BkCountLst
(progn
(setq BkCountLst
(vl-sort BkCountLst
(function (lambda (e1 e2)
(< (car e1) (car e2))
)
)
)
)
;(mapcar 'print BkCountLst)
(princ "finalizado")
(cond ((collection-item-p
(vla-get-dictionaries *adoc*)
"TablaBlocks"
)
)
(T
(AddTextStyle "Anot_Arial" "ARIAL" *adoc*)
(setq *tableStyle* (vla-item (vla-get-dictionaries *adoc*)
"acad_tablestyle"
)
*tabla* (vla-addObject
*tableStyle*
"TablaBlocks"
"AcDbTableStyle"
)
)
(vla-SetTextHeight *tabla* acTitleRow 0.175)
(vla-SetTextHeight *tabla* acHeaderRow 0.135)
(vla-SetTextHeight *tabla* acDataRow 0.125)
(vla-SetTextStyle *tabla* acHeaderRow "Anot_Arial")
(vla-SetTextStyle *tabla* acTitleRow "Anot_Arial")
(vla-SetTextStyle *tabla* acDataRow "Anot_Arial")
(vla-put-Vertcellmargin *tabla* 0.075)
(vla-put-Horzcellmargin *tabla* 0.175)
)
)
(or ptt
(setq
ptt
;(trans
(getPoint
"\n Especifica el punto de inserción para la tabla:"
)
;;; 1
;;; 0
;;; )
)
)
(progn
(princ "\n Creando tabla, espera... ")
(setq Ptt (vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbDouble
'(0 . 2)
)
ptt
)
)
;;;object.AddTable(InsertionPoint, NumRows, NumColumns, RowHeight, ColWidth)
Table1 (vla-addTable
(vla-get-ModelSpace
*adoc*
)
ptt
2
3
0.20
2.00
)
ctc 0
)
(vla-put-StyleName Table1 "TablaBlocks")
(vla-setText
Table1
0
0
(strcase (strcat "Bloques en "
(if (= SpaceBkCt "Ambos")
"dibujo"
SpaceBkCt
)
)
)
)
(vla-setText Table1 1 0 "BLOQUE")
(vla-setText Table1 1 1 "NOMBRE")
(vla-setText Table1 1 2 "CANTIDAD")
(vla-setcolumnwidth Table1 0 1.20)
(vla-setcolumnwidth Table1 1 3.00)
(vla-setcolumnwidth Table1 2 1.45)
(vla-setRowHeight Table1 0 0.50)
(vla-setrowHeight Table1 1 0.35)
(if (setq NwUcs (NameUnnamedUcs *adoc* "BTUcs"))
(progn
(setq TransMatrix (vla-getUcsMatrix NwUcs))
(vla-TransformBy Table1 TransMatrix)
)
)
)

(setq row 2)
(foreach BksLst BkCountLst ;(setq BksLst (car BkCountLst))
(vla-insertrows Table1 row 0.35 1)
(setq Col_ct 0)
(vla-SetCellType Table1 row Col_ct acBlockCell)
(vla-SetBlockTableRecordId
Table1
row
Col_ct
(vla-get-ObjectID (vla-item *blocks* (car BksLst)))
:vlax-true
)
(setq col_ct (1+ Col_Ct)
)
(vla-SetText
Table1
(vlax-make-Variant row vlax-vbLong)
Col_ct
(vlax-Make-Variant (strcase (car BksLst)) Vlax-VbString)
)
(setq col_ct (1+ Col_Ct)
)
(vla-SetText
Table1
(vlax-make-Variant row vlax-vbLong)
Col_ct
(vlax-Make-Variant (cdr BksLst) Vlax-VbString)
)
(setq row (1+ row)
)
)
(setq ctrow 2)
(repeat (- (vla-get-rows table1) 2)
(vla-setcellalignment Table1 ctrow 1 acmiddleleft)
(setq ctrow (1+ ctrow))
)
(princ "finalizado")
)
(mapcar 'princ
(list "\n No hay referencias del bloque en "
SpaceBkCt
"."
)
)
)
(vla-endundomark *adoc*)
(princ)
)