Tabla de coordenadas de puntos

Ver el tema anterior Ver el tema siguiente Ir abajo

Tabla de coordenadas de puntos

Mensaje por Dominguez el Mar Mar 29, 2016 8:48 pm

Bueno como inicio de una duradera y gran aventura, voy a colaborar con una rutina que quiza a alguno le resulte valida para sus tareas cotidianas.
Crea una tabla de Autocad con las coordenadas X Y de los puntos indicados por el usuario, quizas ya exista alguna parecida pero esta actualiza las coordenadas si movemos los puntos de su sitio inicial.
Un saludo para todos y feliz travesia por este gran desierto.
Version Mejorada
Código:
; Crea una tabla con las coordenadas XY de los puntos indicados.
;;;ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun inicio ()
  (setq cont 3) ; 1ª fila para insertar datos
  (setq row 3) ; número filas, incluso titulo y encabezados
  (setq col 3) ; número columnas
  (if (not *altxt*)
    (setq *altxt* (getreal "\nAltura textos: "))
    (setq *altxt* *altxt*)
  )
  (setq p 1) ; valor si para seguir insertando puntos
  (setq sn 0) ; valor control altura texo
)
;;;ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
;; Crea estilo de tabla estandar
(defun crea_tbl ()
  (setq acmcol (vla-getinterfaceobject
                 (vlax-get-acad-object)
                 (strcat "AutoCAD.AcCmColor." (substr (getvar "ACADVER") 1 2))
               )
  )
  (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))
  (if (not (tblobjname "STYLE" "TABLA"))
    (entmake (list '(0 . "STYLE") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbTextStyleTableRecord")
                   '(2 . "TABLA") '(70 . 0) '(40 . 0.0) '(41 . 0.0) '(50 . 0.0) '(71 . 0) '(3 . "ARIAL") '(4 . "")
                  )
    )
  )
  (setq tblstl (vla-item (vla-get-dictionaries *adoc*) "acad_tablestyle"))
  (setq tbl (vla-addobject tblstl "cuadro" "AcDbTableStyle"))
  (vla-settextstyle tbl acheaderrow "tabla")
  (vla-settextstyle tbl actitlerow "tabla")
  (vla-settextstyle tbl acdatarow "tabla")
  (vla-settextheight tbl actitlerow (* *altxt* 1.5)) ;altura texto titulo
  (vla-settextheight tbl acheaderrow *altxt*) ;altura texto cabecera
  (vla-settextheight tbl acdatarow *altxt*) ;altura texto celdas
  (vla-setalignment tbl actitlerow acmiddleleft)
  (vla-setalignment tbl acheaderrow acmiddleleft)
  (vla-setalignment tbl acdatarow acmiddleleft)
  (vla-put-vertcellmargin tbl (* *altxt* 0.5)) ; margen vertical
  (vla-put-horzcellmargin tbl (* *altxt* 0.5)) ; margen horizontal
  (setvar 'ctablestyle "cuadro")
)
;;;ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
 ; formatear la tabla
(defun formato_tbl ()
  (setq pt (vlax-3d-point (getpoint "\nPunto de inserción de tabla: ")))
  (setq tbl (vla-addtable (vla-get-modelspace *adoc*) pt row col *altxt* *altxt*))
  (vla-put-stylename tbl "cuadro")
  (vla-settextheight tbl actitlerow (* *altxt* 1.5)) ;altura texto titulo
  (vla-settextheight tbl acheaderrow *altxt*) ;altura texto cabecera
  (vla-settextheight tbl acdatarow *altxt*) ;altura texto celdas
  (vla-setcolumnwidth tbl 0 (* *altxt* 5)) ;anchura 1ª columna
  (vla-setcolumnwidth tbl 1 (* *altxt* 11)) ;anchura 2ª columna
  (vla-setcolumnwidth tbl 2 (* *altxt* 11)) ;anchura 3ª columna
  (vla-settext tbl 1 0 "Punto") ;CABECERA 1
  (vla-settext tbl 1 1 "Coordenada X") ;CABECERA 2
  (vla-settext tbl 1 2 "Coordenada Y") ;CABECERA 3
  ;; cambiamos colores de textos
  (vla-put-colorindex acmcol 2) ; amarillo
  (vla-setcellcontentcolor tbl 0 0 acmcol) ; titulo amarillo
  (vla-put-colorindex acmcol 3) ; verde
  (vla-setcellcontentcolor tbl 1 0 acmcol) ; cabecera punto amarillo
  (vla-put-colorindex acmcol 1) ; rojo
  (vla-setcellcontentcolor tbl 1 1 acmcol) ; cabecera coordenadaX rojo
  (vla-put-colorindex acmcol 4) ; ciano
  (vla-setcellcontentcolor tbl 1 2 acmcol) ; cabecera coordenadaY ciano
)
;;;ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun puntos ()
  (if (= sn 0)
    (progn (setq pto 1)
           (if (not *numero*)
             (setq *numero* (getint "\nNúmero punto inicio: "))
             (progn (setq num (getint (strcat "\nNúmero punto inicio: <" (itoa *numero*) ">")))
                    (if (/= num nil)
                      (setq *numero* num)
                    )
             )
           )
    )
  )
  (setq pto (getpoint (strcat "\nIndicar Punto: <" (itoa *numero*) ">")))
  (if (= pto nil)
    (setq p nil)
  )
  (setq numero$ (strcat "P" (itoa *numero*)))
  (if (/= pto nil)
    (progn (vl-cmdf "_insert" "PUNTO_TBL" pto *altxt* *altxt* 0 numero$)
           (setq blk (vlax-ename->vla-object (entlast)))
           (setq x (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                           (itoa (vla-get-objectid blk))
                           ">%).InsertionPoint \\f "%lu2%pt1%pr3">%"
                   )
           )
           (setq y (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                           (itoa (vla-get-objectid blk))
                           ">%).InsertionPoint \\f "%lu2%pt2%pr3">%"
                   )
           )
           (setq *numero* (1+ *numero*))
           (if (= sn 0)
             (setq 1ºpunto numero$)
           )
           (setq sn 1)
    )
  )
)
;;;ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun inserta_datos ()
  (if (= p 1)
    (progn (vla-insertrows ; insertamos filas
             tbl
             cont
             *altxt* ;altura fila insertada
             1 ;cantidad de filas
           )
           (setq row (1+ row)) ; incrementamos el numero de filas
           (vla-settext tbl (1- cont) 0 numero$) ; nombre del punto
           (vla-settext tbl (1- cont) 1 x) ; coordenada X
           (vla-settext tbl (1- cont) 2 y) ; coordenada Y
           ;; cambiamos colores de textos
           (vla-put-colorindex acmcol 3) ; verde
           (vla-setcellcontentcolor tbl (1- cont) 0 acmcol) ; titulo verde
           (vla-put-colorindex acmcol 1) ; rojo
           (vla-setcellcontentcolor tbl (1- cont) 1 acmcol)
           (vla-put-colorindex acmcol 4) ; ciano
           (vla-setcellcontentcolor tbl (1- cont) 2 acmcol)
           (setq cont (1+ cont))
    )
  )
)
;;;ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun bloque_punto ()
  (if (not (tblobjname "LAYER" "TBL_PTOS"))
    (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord")
                   '(2 . "TBL_PTOS") '(70 . 0) '(62 . 8) '(6 . "CONTINUOUS")
                  )
    )
  )
  (setvar 'clayer "TBL_PTOS")
  (if (not (tblobjname "BLOCK" "PUNTO_TBL"))
    (foreach h (list (list '(0 . "BLOCK") '(100 . "AcDbEntity") '(67 . 0) '(8 . "TBL_PTOS")
                           '(100 . "AcDbBlockBegin") '(1 . "PUNTO_TBL") '(2 . "PUNTO_TBL") '(70 . 2)
                           '(10 0.0 0.0 0.0)
                          )
                     (list '(0 . "LINE") '(100 . "AcDbEntity") '(67 . 0) '(410 . "Model") '(8 . "TBL_PTOS")
                           '(100 . "AcDbLine") '(10 -0.5 0.0 0.0) '(11 0.5 0.0 0.0) '(210 0.0 0.0 1.0)
                          )
                     (list '(0 . "LINE") '(100 . "AcDbEntity") '(67 . 0) '(410 . "Model") '(8 . "TBL_PTOS")
                           '(100 . "AcDbLine") '(10 0.0 0.5 0.0) '(11 0.0 -0.5 0.0) '(210 0.0 0.0 1.0)
                          )
                     (list '(0 . "ATTDEF") '(100 . "AcDbEntity") '(67 . 0) '(410 . "Model") '(8 . "TBL_PTOS")
                           '(100 . "AcDbText") '(10 -1.47619 1.5 0.0) '(40 . 1.0) '(1 . "") '(50 . 0.0) '(41 . 1.0)
                           '(51 . 0.0) '(7 . "TABLA") '(71 . 0) '(72 . 1) '(11 9.18455e-017 1.5 0.0)
                           '(210 0.0 0.0 1.0) '(100 . "AcDbAttributeDefinition") '(3 . "PUNTO") '(2 . "PUNTO")
                           '(70 . 0) '(72 . 1) '(73 . 0) '(74 . 0) '(280 . 0)
                          )
                     (list '(0 . "ENDBLK"))
               )
      (entmake h)
    )
  )
)
;;;ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun c:tabla_puntos (/ lay acmcol cont row col p sn tblstl blk tbl pt *adoc* pto num numero$ x y 1ºpunto)
  (setvar 'cmdecho 0)
  (vl-load-com)
  (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
  (setq lay (getvar 'clayer))
  (inicio)
  (crea_tbl)
  (bloque_punto)
  (formato_tbl)
  (while p (puntos) (inserta_datos))
  (vla-settext tbl 0 0 (strcat "TABLA PUNTOS " 1ºpunto "-P" (itoa (1- (atoi (substr numero$ 2))))))
  (vla-deleterows tbl (1- cont) 1) ; elimina la ultima fila vacia
  (setvar 'clayer lay)
  (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
  (prin1)
)
;;;ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo


Última edición por Dominguez el Jue Mar 31, 2016 8:23 pm, editado 2 veces

Dominguez

Mensajes : 43
Fecha de inscripción : 20/03/2016
Edad : 66
Localización : Zaragoza (España)

Ver perfil de usuario

Volver arriba Ir abajo

Re: Tabla de coordenadas de puntos

Mensaje por robierzo el Mar Mar 29, 2016 10:49 pm

Muy buena Domínguez. Sobre todo para aprender muchas cosas.!!!!
Aunque yo aún utilizo esta que va genial, excepto por el tema de actualizar las coordenadas en la tabla cuando se mueve un punto.



Ya llovió desde que hicieras la primera versión, pero sigue estando en plena vigencia.

robierzo

Mensajes : 35
Fecha de inscripción : 17/03/2016
Localización : La Coruña

Ver perfil de usuario http://www.selmotopografia.es

Volver arriba Ir abajo

Re: Tabla de coordenadas de puntos

Mensaje por Dominguez el Mar Mar 29, 2016 11:58 pm

robierzo escribió:Muy buena Domínguez. Sobre todo para aprender muchas cosas.!!!!
Aunque yo aún utilizo esta que va genial, excepto por el tema de actualizar las coordenadas en la tabla cuando se mueve un punto.



Ya llovió desde que hicieras la primera versión, pero sigue estando en plena vigencia.
Cuanto me gusta que a la gente le sirvan mis rutinas
Un saludo

Dominguez

Mensajes : 43
Fecha de inscripción : 20/03/2016
Edad : 66
Localización : Zaragoza (España)

Ver perfil de usuario

Volver arriba Ir abajo

Re: Tabla de coordenadas de puntos

Mensaje por saulo2016 el Miér Mar 30, 2016 2:54 am

A mi ademas del cuadro de coordenadas del maestro Dominguez utilizo bastante el DTCODOS....esa rutina a como me ha servido para hacer los codos mitrados en 3D.....Maestro Dominguez le debo muchisimo!!!!

Gracias


Saludos

saulo2016

Mensajes : 84
Fecha de inscripción : 17/03/2016
Edad : 51
Localización : Monterrey, Nuevo León, Mexico

Ver perfil de usuario

Volver arriba Ir abajo

Re: Tabla de coordenadas de puntos

Mensaje por saulo2016 el Miér Mar 30, 2016 3:05 am

Pregunta:

Como le hago para pegar IMAGENES como ustedes lo hacen ???


saludos

saulo2016

Mensajes : 84
Fecha de inscripción : 17/03/2016
Edad : 51
Localización : Monterrey, Nuevo León, Mexico

Ver perfil de usuario

Volver arriba Ir abajo

Re: Tabla de coordenadas de puntos

Mensaje por robierzo el Miér Mar 30, 2016 11:07 am

saulo, cuando escribes un mensaje hay un icono que sirve para alojar una imagen. Es el que está en la posición nº 13, el primero del 4º bloque de iconos.

robierzo

Mensajes : 35
Fecha de inscripción : 17/03/2016
Localización : La Coruña

Ver perfil de usuario http://www.selmotopografia.es

Volver arriba Ir abajo

Re: Tabla de coordenadas de puntos

Mensaje por Admin el Sáb Abr 02, 2016 12:33 am


Y luego trabajas en este cuadro



Admin
Admin

Mensajes : 124
Fecha de inscripción : 16/03/2016
Edad : 68
Localización : CORDOBA ARGENTINA

Ver perfil de usuario http://acadhispano.foroargentina.net

Volver arriba Ir abajo

Re: Tabla de coordenadas de puntos

Mensaje por Contenido patrocinado Hoy a las 11:03 pm


Contenido patrocinado


Volver arriba Ir abajo

Ver el tema anterior Ver el tema siguiente Volver arriba

- Temas similares

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