Mover a una nueva ubicación

Ir abajo

Mover a una nueva ubicación Empty Mover a una nueva ubicación

Mensaje por Zicaryd el Miér Oct 02, 2019 3:59 pm

Buenos días.
Quiero pedirles algunas sugerencias u apoyo sobre un tema que se me presenta.
Tengo un grupo de Bloques con atributos Codificados que se encuentran insertados. pero ahora cada uno ha cambiado de ubicación, y esas nuevas ubicaciones de los puntos de inserción los tengo en excel
Quiero cambiarlos a su nueva ubicación como podría hacerlos, necesito algunas ideas.
slds.

Zicaryd

Mensajes : 34
Fecha de inscripción : 23/10/2016

Volver arriba Ir abajo

Mover a una nueva ubicación Empty Re: Mover a una nueva ubicación

Mensaje por bernie67 el Dom Oct 06, 2019 3:23 am

Hola que pena no haber contestado antes. Yo volvería a insertar los bloques. Si deseas recuperar los valores que contenían usaría el data extraction y luego generaría de nuevo la tabla de excel y usaría un lisp para insertarlos en el nuevo sitio. Esta rutina era de un compañero de Hispacad, Marco Jacinto, espero te funcione, sino tocaría con otras que debo tener
Saludos
Bernardo Corradine

(vl-load-com)

;|

;|Rutina creada para hispacad, http://www.hispacad.com/foro/viewtopic.php?f=2&t=68699
Marco Jacinto Mayo 2015

La Funcion ExcelATablaBloque crea una pseudotabla (a base de un bloque con atributos),
con la informacion que se encuentre en la hoja activa de Excel, esta Información deberá
contener siempre una primera fila de encabezados, en la cual deben estar presentes un
valor "X", "Y" y NOMBLOQUE, sin importar si son mayusculas o minusculas y su posicion en la
hoja activa. El resto de los valores debe coincidir con las Etiquetas del bloque, en caso
que alguna no coincida, no se procesa.

El comando obtendra los puntos "X" e "Y" de la tabla y en esta posicion se colocaran los
Bloques/Filas, por lo que el calculo debe ser exacto en el caso del bloque/fila.

La columa NomBloque indicara el nombre del bloque a insertar.

1 2 3 4 x y NomBloque
p1 c -99.19674484 19.45267612 30 158 Mcoan_FilaTabla
p2 c -99.22912374 19.47404417 30 155.5 Mcoan_FilaTabla
p2 c -99.22912374 19.47404417 30 153 Mcoan_FilaTabla
p2 c -99.22912374 19.47404417 30 150.5 Mcoan_FilaTabla
p3 c -99.19620109 19.45255125 30 148 Mcoan_FilaTabla
p4 c -99.19601757 19.45249735 30 145.5 Mcoan_FilaTabla
p5 c -99.19552164 19.4523713 30 143 Mcoan_FilaTabla


El comando no esta supeditado a un bloque/fila, se puede usar cualquier bloque o
bloques e insertarlos en las posiciones indicadas en las columnas X,Y.

Los bloques indicados en la columna NomBloque deben de existir previamente.

Requiere la funcion GetCurExcelWoorBook, que se encuentra en este post
http://www.hispacad.com/foro/viewtopic.php?f=2&t=68483#p230616

El comando se podría extender de una manera sencilla para permitir el escalado del bloque,
orientacion, layer, etc. todo con informacion presente en la hoja de excel.

Utiliza la variable Luprec para controlar la precision de los numeros reales.

|;
(DEFUN c:ExcelATablaBloque (/ BKOBJ LSTDATOS LSTPARES X Y Z ct)
(SETQ MU:THISDRAWING (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT)))
(if (SETQ lstDatos (GetCurExcelWoorBook))
(progn
(SETQ lstPares (MAPCAR '(LAMBDA (x)
(MAPCAR '(LAMBDA (y z)
(LIST (strcase y) z) ;_ mapcar
) ;_ LAMBDA
(CAR lstdatos)
X
) ;_ lambda
) ;_ LAMBDA
(CDR lstdatos)
) ;_ MAPCAR
) ;_ SETQ
;;;(setq fila (car lstpares))
(SETQ ct 0)
(FOREACH Fila lstPares
(IF (TBLSEARCH "BLOCK"
(SETQ Nombloque (CADR (ASSOC "NOMBLOQUE" fila)))
) ;_ TBLSEARCH
(PROGN
(mu*CajaHerr_BlockPutAtts
(VLA-INSERTBLOCK
(VLA-GET-MODELSPACE MU:THISDRAWING)
(VLAX-3D-POINT
(CADR (ASSOC "X" fila))
(CADR (ASSOC "Y" fila))
) ;_ VLAX-3D-POINT
Nombloque
1
1
1
0
) ;_ VLA-INSERTBLOCK
Fila
) ;_ mu*CajaHerr_BlockPutAtts
(SETQ ct (1+ ct))
) ;_ PROGN
) ;_ IF
) ;_ FOREACH
(MAPCAR 'PRINC
(LIST "\n Se insertaron "
ct
" bloque(s) a partir de info en Excel"
) ;_ LIST
) ;_ MAPCAR
) ;_ progn
(princ "\n Sin datos a procesar, saliendo.")
) ;_ if
(PRINC)
)

;| ;
Funcion mu*CajaHerr_BlockPutAtts ;
;
Objetivo: ;
Establecer los valores de una lista en los atributos de un bloque utilizando las etiquetas del mismo ;
;
Parametros: ;
BkObj - Un objeto Vla que haga referencia a la insercion de un bloque ;
AttLstCh - Una lista con listas de pares de datos ;
;
Valor de salida: ;
;
El texto escrito en excel en la fila y columna correspondiente, la fila se debe procesar en la funcion ;
que utilice a mu*Block2Excel_EscribeAttXls ;
;
Uso: ;
;
(mu*CajaHerr_BlockPutAtts
(vlax-ename->vla-object (car (entsel)))
'(("Tag Attributo" "Valor Atributo")
("Tag Attributo2" "Valor Atributo2")
)
) ;_ .mu*CajaHerr_BlockPutAtts
;
Necesita las siguientes funciones: ;
mu*CajaHerr_VariantArray->List ;
;
Por hacer: ;
Nada ;
;
Consideraciones: ;
Se pueden usar comodines en las etiquetas ya que la funcion utiliza wcmatch para encontrar el valor ;
que corresponde ;
|;
(DEFUN mu*CajaHerr_BlockPutAtts (BkObj
AttLstCh
/
ATTVAL
)
(FOREACH Propset AttLstCh
(FOREACH att (mu*CajaHerr_VariantArray->List (VLA-GETATTRIBUTES BkObj))
(SETQ AttVal nil)
(COND
((NULL (CAR Propset)))
((NOT (WCMATCH (VLA-GET-TAGSTRING att) (strcase(CAR Propset)))))
((AND (LISTP (CADR Propset))
(NOT (SETQ AttVal (EVAL (CADR Propset))))
) ;_ .AND
)
(T
(OR AttVal (SETQ AttVal (CADR Propset)))
(IF (OR (= 'REAL (TYPE ATTVAL))
(= 'REAL (TYPE (READ ATTVAL)))
) ;_ OR
(SETQ ATTVAL (RTOS ATTVAL
2
(IF (ZEROP (REM ATTVAL 0.50))
0
(getvar 'luprec)
)
)
)
) ;_ IF
(AND AttVal
(VL-CATCH-ALL-APPLY 'VLA-PUT-TEXTSTRING (LIST att AttVal))
) ;_ .AND
)
) ;_ .COND
) ;_ .FOREACH
) ;_ .FOREACH
) ;_ .DEFUN


;| ;
Funcion mu*CajaHerr_VariantArray->List ;
;
Objetivo: ;
Convierte un Variant array obtenido por alguna funcion vla en una lista simple ;
;
Parametros: ;
Var - El varian que se obtiene mediante alguna funcion vla ;
;
Valor de salida: ;
;
Una lista con los objetos o valores que componan el array ;
;
Uso: ;
;
(mu*CajaHerr_VariantArray->List (vla-GetAttributes (vlax-ename->vla-object (car(entsel)))))
;
Necesita las siguientes funciones: ;
Ninguna ;
;
Por hacer: ;
Nada ;
;
Consideraciones: ;
Se genero esta funcion ya que aal obtener los valores del variant, si este no tiene algun valor, el ;
programa genera un error y hay que procesarlo antes de cont
|;
(DEFUN mu*CajaHerr_VariantArray->List (Var / val)
(SETQ val (VL-CATCH-ALL-APPLY
'VLAX-SAFEARRAY->LIST
(LIST (VLAX-VARIANT-VALUE Var))
) ;_ .VL-CATCH-ALL-APPLY
) ;_ .SETQ
(IF (VL-CATCH-ALL-ERROR-P
val
) ;_ .VL-CATCH-ALL-ERROR-P
nil
val
) ;_ .IF
) ;_ .DEFUN

;|
Funciones publicadas en http://www.hispacad.com/foro/posting.php?mode=reply&f=2&t=68483#preview
Autor: Marco Jacinto, Guadalajara, Mexico 2015 :copyright:Mcommands 2015
|;

(DEFUN c:Datos2tabla (/ LSTDATOS OBJTABLA SUPRIMIRREGENERAR)

;;; (setq lstDatos (GetCurExcelWoorBook))
(SETQ lstdatos '(
("Variable" "Valor")
("Sentido" 1.0)
("Velocidad" 2.0)
("Deflecion" 3.0)
("PI" 4.0)
("PC" 5.0)
("PT" 6.0)
)
)
(SETQ ObjTabla (VLAX-ENAME->VLA-OBJECT (CAR (ENTSEL))))
(EscribeDatosenTabla
ObjTabla
"Tabla 1"
lstDatos
SuprimirRegenerar
T
)

(PRINC)
)


;;;Obtiene la informacion dela hoja activa e excel
(DEFUN GetCurExcelWoorBook
(/ A B INTCOUNT1 INTCOUNT2 NWWB RC WBCELLS WBSHT EXCEL)
(SETQ excel (VLAX-GET-OBJECT "excel.application"))

(if (SETQ NwWb (VLAX-GET-PROPERTY excel 'aCTIVEWorkbook))
(progn
(VLAX-PUT excel 'VISIBLE :VLAX-TRUE)
(SETQ WBSht (VLAX-GET-PROPERTY NwWb 'activeSheet)
WBCells (VLAX-GET-PROPERTY WBSht 'usedRange)
intCount1 1)
;;;;Se necesitan procesar el numero de filas y el no de columnas
(REPEAT
(VLAX-GET-PROPERTY (VLAX-GET-PROPERTY WBCells 'Rows) 'count)
(SETQ intCount2 1)
(REPEAT (VLAX-GET-PROPERTY
(VLAX-GET-PROPERTY WBCells 'Columns)
'count
) ;_ VLAX-GET-PROPERTY
(SETQ rc (STRCAT (CHR (+ 64 intCount2))
(ITOA intCount1)
) ;_ STRCAT
) ;_ SETQ
(SETQ a (CONS (VLAX-VARIANT-VALUE
(VLAX-GET-PROPERTY
(VLAX-GET-PROPERTY
WBCells
'Range
rc
) ;_ VLAX-GET-PROPERTY
"value2"
) ;_ VLAX-GET-PROPERTY
) ;_ VLAX-VARIANT-VALUE
a
) ;_ CONS
) ;_ SETQ
(SETQ intCount2 (1+ intCount2))
) ;_ REPEAT
(SETQ b (CONS (REVERSE a) b))
(SETQ intCount1 (1+ intCount1)
a nil
) ;_ SETQ
) ;_ REPEAT
) ;_ progn
(progn
(alert "\n No hay una sesion activa de excel, abre el archivo xls e intenta de nuevo.")
z
l
;;(vlax-dump-Object excel t)
)
) ;_ if
(if b
(REVERSE b)
) ;_ if
)

;|
La función EscribeDatosenTabla grabará los valores de una lista siguiendo el valor de los
encabezados indicados. Los encabezados deberan estar en el primer elemento de la lista
Los valores deben de tener este formato
(setq lstdatos '(
("Variable" "Valor");;;Los encabezados de los valores
("Sentido" 1.0)
("Velocidad" 2.0)
("Deflecion" 3.0)
("PI" 4.0)
("PC" 5.0)
("PT" 6.0)
))
|;
(defun EscribeDatosenTabla (ObjTabla Titulo lstDatos
SuprimirRegenerar mu*TieneEncabezados?
/ COLCT
ENCABEZADOS LSTIDS
ROW X
Y Z
)
(if (and ObjTabla
lstDatos
(eq (type ObjTabla) 'VLA-OBJECT)
)
(progn
(If SuprimirRegenerar
(vla-put-RegenerateTableSuppressed ObjTabla :vlax-true)
)
(setq row 0)
(if (eq (vla-get-titlesuppressed ObjTabla) :vlax-false)
(progn
(vla-settext
ObjTabla
row
0
Titulo
)
(setq row (1+ row))
)
);;;(setq ObjTabla (c:dump))
(if (eq (vla-get-headersuppressed ObjTabla) :vlax-false) ;_Modificado por mcoan 4/29/13 8:52 PM
(progn
(setq row (1+ row))
)
)
(setq Encabezados (car lstDatos))
(setq LstIds (if mu*TieneEncabezados?
;;;Se agregó esta variable global para evitar reescribir la función, con
;;;ella se le dice a la funcion que la lista ya viene con la cadena de texto PARA ubicar el encabezado
(cdr lstDatos)
(mapcar '(lambda (x)
(mapcar '(lambda (y z)
(list y z)
)
Encabezados
x
)
)
lstDatos
)
)
)
(setq row 1)
(AgregaColRows ObjTabla "columns")
(AgregaColRows ObjTabla "rows")
;;; (setq ObjTabla (c:dump))
(repeat (progn (setq colct -1) (length Encabezados))
(vla-SetColumnWidth
ObjTabla
(setq colct (1+ colct))
(* 1.75 (STRLEN (nth Colct Encabezados)))
)
)
(MAPCAR '(LAMBDA (x)
(MAPCAR '(lambda (y)
(ProcesaListaDatos y nil)
)
x
)
(SETQ row (1+ row))
)
LstIds
)
(if SuprimirRegenerar
(vla-put-RegenerateTableSuppressed ObjTabla :vlax-false)
)
)
)
)


(DEFUN ProcesaListaDatos (x mu:lstTextos / ATTTAG ENCABUSCAR)
(SETQ AttTag (CAR x)
AttText (CADR x)
)
(SETQ EncABuscar
(IF (SETQ EncABuscar (dxf atttag mu:lstTextos))
EncABuscar
AttTag
)
)
(EscribeDatosAlFinal AttText)
)

(DEFUN EscribeDatosAlFinal (txt / COLUMNS INTCOUNT2 POS ROWS)
(IF (AND TXT (SETQ pos (VL-POSITION EncABuscar Encabezados)))
(PROGN
(SETQ intCount2 pos
)
(VLA-SETTEXT
ObjTabla
row
intCount2
txt
)
(SETQ intCount2 (1+ intCount2))
)
)
)

;;;(setq TipoProcesar "columns")
;;;(setq TipoProcesar "rows")

(DEFUN AgregaColRows (ObjTabla TipoProcesar / COLS OLDCOLS REP TOTALCOLS)
(IF (<= (SETQ oldcols
(SETQ cols (VLAX-GET-PROPERTY ObjTabla TipoProcesar))
)
(SETQ totalcols (IF (= TipoProcesar "columns")
(LENGTH (CAR lstDatos))
(1+ (LENGTH LstIds))
)
)
)
(PROGN
(REPEAT (SETQ rep (- totalcols cols))
(SETQ cols (APPLY (READ (STRCAT "Vla-get-" TipoProcesar))
(LIST ObjTabla)
)
)
(APPLY (READ (STRCAT "vla-insert" TipoProcesar))
(LIST ObjTabla
(1- cols)
0.1
1
)
)
)
(SETQ oldcols (1- oldcols))
(REPEAT rep
;;;;;; (vla-SetTextHeight ObjTabla oldcols 0.15)
;;; (if (= TipoProcesar "columns")
;;;;;; (vla-SetColumnWidth ObjTabla oldcols 2.4)
;;; (vla-SetRowHeight ObjTabla oldcols 0.15)
;;; )
(SETQ oldcols (1+ oldcols))
)
)
)
)



bernie67
bernie67

Mensajes : 76
Fecha de inscripción : 22/03/2016
Edad : 52
Localización : Bogota DC-Colombia

Volver arriba Ir abajo

Volver arriba


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