Importar vistas desde un dibujo (cerrado)

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