Colabora VB6

Manejar dibujos de AutoCAD en tus aplicaciones

(Sin tener AutoCAD)

 

Fecha: 08/Oct/2006 (28-09-06)
Autor: ManelTB ([email protected]

 


Introducción

En ocasiones tenemos que desarrollar aplicaciones que necesitan la visualización de archivos de AutoCAD. Hasta ahí no hay problemas puesto que hay por la red infinidad de visores básicos donde puedes ver dibujos, hacer zoom, imprimir y más cosas. Estos controles pueden ser incrustados en la aplicación y a funcionar. Pero ¿qué ocurre si necesitas acceder a nivel de entidad?, es decir, cuando necesitas saber el id interno, el color, la capa, etc. de una línea, polígono o bloque porque ese elemento gráfico tiene una correspondencia con un registro en tu base de datos, o necesitas resaltar un elemento del dibujo, etc.

 

MTBViewerX.OCX

Es un control activeX, licenciado y basado en la tecnología de Cadology Ltd, dotado de procedimientos, métodos y eventos específicos diseñados para la realización de tareas de visualización, consulta y representación de información sobre archivos ".DWG" de AutoCAD.

Este control puede ser incrustado en un formulario, tanto en VB6 o en VB.NET (Como un objeto COM. VS.NET ya se encarga de generar los ensamblados).

Este control ActiveX es gratuito para labores de investigación y desarrollo. Se trata de que lo descargues y lo pongas a prueba. Para facilitar las cosas se acompaña a este artículo la instalación de un programa que registrará todos los componentes que necesitas (en tu carpeta system32 \MTBViewerX\... los encontrarás copiados e instalados y podrás usarlo en tu aplicación). Con la instalación se acompaña el manual completo del control y también el proyecto en VB6 del programa para que puedas ver cómo se maneja el control.

El programa para poner a prueba el control ActiveX consiste en un formulario que contiene algunos de los comandos más relevantes. En él podrás comprobar cómo, mediante la obtención del nombre del dibujo y del ehandle de entidad de AutoCAD establecemos una relación biunívoca entre cada habitación y la persona o personas que la ocupan. Cada una de las habitaciones está representada mediante una polilínea (elige la combinación de capas polys) a la que se asocia el registro de la parrilla.

 

Prueba a hacer clic sobre la celda "Color" de la parrilla de datos para cambiar el color con el que quieres representar el espacio. Con la combinación de capas "polys" podrás cambiar la asociación entre un espacio y el registro actual.

El código:

A continuación el código del formulario.

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{4AB6EFAF-ABD2-4CE0-BC95-208F6459144E}#1.0#0"; "MTBViewerX.ocx"
Begin VB.Form Form1
   BorderStyle     =   1  'Fixed Single
   Caption         =   "MTBViewerX - Demo"
   ClientHeight    =   7800
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   10665
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   7800
   ScaleWidth      =   10665
   StartUpPosition =   3  'Windows Default
   Begin MTBViewerX_VS6.MTBViewerX MTBViewerX1
      Height          =   4275
      Left            =   120
      TabIndex        =   47
      Top             =   180
      Width           =   7215
      _ExtentX        =   12726
      _ExtentY        =   7541
   End
   Begin VB.Frame Frame2
      Height          =   2475
      Left            =   7440
      TabIndex        =   35
      Top             =   5280
      Width           =   3195
      Begin VB.CommandButton btTodosTextos
         Caption         =   "Todos textos"
         Height          =   315
         Left            =   1620
         TabIndex        =   43
         Top             =   540
         Width           =   1515
      End
      Begin VB.CommandButton btTematico
         Caption         =   "Tamático"
         Height          =   315
         Left            =   60
         TabIndex        =   42
         Top             =   540
         Width           =   1515
      End
      Begin VB.CommandButton btDesenlazar
         Caption         =   "Desenlazar"
         Height          =   315
         Left            =   1620
         TabIndex        =   41
         Top             =   180
         Width           =   1515
      End
      Begin VB.CheckBox chkTextoADibujo
         Caption         =   "Poner texto al seleccionar"
         Height          =   255
         Left            =   240
         TabIndex        =   40
         Top             =   1860
         Value           =   1  'Checked
         Width           =   2835
      End
      Begin VB.OptionButton OpcHatch
         Caption         =   "Remarcar con recuadro"
         Height          =   255
         Index           =   2
         Left            =   240
         TabIndex        =   39
         Top             =   1560
         Width           =   2835
      End
      Begin VB.OptionButton OpcHatch
         Caption         =   "Remarcar con hatch si polylinea"
         Height          =   255
         Index           =   1
         Left            =   240
         TabIndex        =   38
         Top             =   1260
         Width           =   2835
      End
      Begin VB.OptionButton OpcHatch
         Caption         =   "No remarcar al seleccionar"
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   37
         Top             =   960
         Value           =   -1  'True
         Width           =   2835
      End
      Begin VB.CommandButton btEnlazar
         Caption         =   "Enlazar"
         Height          =   315
         Left            =   60
         TabIndex        =   36
         Top             =   180
         Width           =   1515
      End
      Begin VB.Label lblTimeDWG
         Height          =   255
         Left            =   1560
         TabIndex        =   46
         Top             =   2160
         Width           =   1455
      End
      Begin VB.Label Label5
         Caption         =   "Tiempo de carga:"
         Height          =   255
         Left            =   240
         TabIndex        =   45
         Top             =   2160
         Width           =   1275
      End
   End
   Begin VB.Frame Frame1
      Caption         =   "Propiedades y parámetros"
      Height          =   5175
      Left            =   7440
      TabIndex        =   8
      Top             =   60
      Width           =   3195
      Begin VB.TextBox txtXMLFile
         Height          =   555
         Left            =   120
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   44
         Top             =   4500
         Width           =   2955
      End
      Begin VB.Label Label14
         Caption         =   "Estilo de texto:"
         Height          =   255
         Left            =   120
         TabIndex        =   33
         Top             =   3300
         Width           =   1515
      End
      Begin VB.Label lblTextStyle
         BorderStyle     =   1  'Fixed Single
         Height          =   255
         Left            =   1740
         TabIndex        =   32
         Top             =   3300
         Width           =   1335
      End
      Begin VB.Label Label13
         Caption         =   "Ang. rotación textos:"
         Height          =   255
         Left            =   120
         TabIndex        =   31
         Top             =   3000
         Width           =   1515
      End
      Begin VB.Label lblTextRotation
         BorderStyle     =   1  'Fixed Single
         Height          =   255
         Left            =   1740
         TabIndex        =   30
         Top             =   3000
         Width           =   1335
      End
      Begin VB.Label Label12
         Caption         =   "Altura de los textos:"
         Height          =   255
         Left            =   120
         TabIndex        =   29
         Top             =   2700
         Width           =   1515
      End
      Begin VB.Label lblTextHeight
         BorderStyle     =   1  'Fixed Single
         Height          =   255
         Left            =   1740
         TabIndex        =   28
         Top             =   2700
         Width           =   1335
      End
      Begin VB.Label Label11
         Caption         =   "Color de los textos:"
         Height          =   255
         Left            =   120
         TabIndex        =   27
         Top             =   2400
         Width           =   1515
      End
      Begin VB.Label lblTextColor
         BorderStyle     =   1  'Fixed Single
         Height          =   255
         Left            =   1740
         TabIndex        =   26
         Top             =   2400
         Width           =   1335
      End
      Begin VB.Label Label10
         Caption         =   "Decimales coord.:"
         Height          =   255
         Left            =   120
         TabIndex        =   25
         Top             =   900
         Width           =   1515
      End
      Begin VB.Label lblDecimales
         BorderStyle     =   1  'Fixed Single
         Height          =   255
         Left            =   1740
         TabIndex        =   24
         Top             =   900
         Width           =   1335
      End
      Begin VB.Label Label9
         Caption         =   "Alineación textos:"
         Height          =   255
         Left            =   120
         TabIndex        =   23
         Top             =   2100
         Width           =   1515
      End
      Begin VB.Label lblTextAlign
         BorderStyle     =   1  'Fixed Single
         Height          =   255
         Left            =   1740
         TabIndex        =   22
         Top             =   2100
         Width           =   1335
      End
      Begin VB.Label Label8
         Caption         =   "Color de sombreado:"
         Height          =   255
         Left            =   120
         TabIndex        =   21
         Top             =   1800
         Width           =   1515
      End
      Begin VB.Label lblHatchColor
         BorderStyle     =   1  'Fixed Single
         Height          =   255
         Left            =   1740
         TabIndex        =   20
         Top             =   1800
         Width           =   1335
      End
      Begin VB.Label Label7
         Caption         =   "Hatch a entidad act:"
         Height          =   255
         Left            =   120
         TabIndex        =   19
         Top             =   1500
         Width           =   1515
      End
      Begin VB.Label lblHatchAEntidad
         BorderStyle     =   1  'Fixed Single
         Height          =   255
         Left            =   1740
         TabIndex        =   18
         Top             =   1500
         Width           =   1335
      End
      Begin VB.Label lblFactorZoom
         BorderStyle     =   1  'Fixed Single
         Height          =   255
         Left            =   1740
         TabIndex        =   17
         Top             =   600
         Width           =   1335
      End
      Begin VB.Label lblZoomAEntidad
         BorderStyle     =   1  'Fixed Single
         Height          =   255
         Left            =   1740
         TabIndex        =   16
         Top             =   1200
         Width           =   1335
      End
      Begin VB.Label Label1
         Alignment       =   2  'Center
         BorderStyle     =   1  'Fixed Single
         Caption         =   "Ruta archivos XML y PRM"
         Height          =   255
         Left            =   120
         TabIndex        =   15
         Top             =   4200
         Width           =   2955
      End
      Begin VB.Label lblDwgVersion
         BorderStyle     =   1  'Fixed Single
         Height          =   255
         Left            =   120
         TabIndex        =   14
         Top             =   3900
         Width           =   2955
      End
      Begin VB.Label Label3
         Alignment       =   2  'Center
         BorderStyle     =   1  'Fixed Single
         Caption         =   "Versión de dibujo AutoCAD"
         Height          =   255
         Left            =   120
         TabIndex        =   13
         Top             =   3600
         Width           =   2955
      End
      Begin VB.Label Label2
         Caption         =   "Factor de zoom:"
         Height          =   255
         Left            =   120
         TabIndex        =   12
         Top             =   600
         Width           =   1515
      End
      Begin VB.Label Label4
         Caption         =   "Zoom a entidad act:"
         Height          =   255
         Left            =   120
         TabIndex        =   11
         Top             =   1200
         Width           =   1515
      End
      Begin VB.Label lblVersionX
         Height          =   255
         Left            =   720
         TabIndex        =   10
         Top             =   300
         Width           =   2355
      End
      Begin VB.Label Label6
         Caption         =   "Versión:"
         Height          =   255
         Left            =   120
         TabIndex        =   9
         Top             =   300
         Width           =   675
      End
   End
   Begin VB.Frame Metodos
      Caption         =   "Métodos para MTBViewerX"
      Height          =   975
      Left            =   120
      TabIndex        =   1
      Top             =   6780
      Width           =   7215
      Begin VB.CommandButton btAreaPerimetro
         Caption         =   "Área y Perímetro"
         Height          =   615
         Left            =   6060
         TabIndex        =   34
         Top             =   240
         Width           =   915
      End
      Begin VB.CommandButton btOpenDWG
         Caption         =   "Abrir dibujo"
         Height          =   615
         Left            =   180
         TabIndex        =   7
         Top             =   240
         Width           =   975
      End
      Begin VB.CommandButton btCloseDWG
         Caption         =   "Cerrar dibujo"
         Height          =   615
         Left            =   1200
         TabIndex        =   6
         Top             =   240
         Width           =   975
      End
      Begin VB.CommandButton btAgregarTxt
         Caption         =   "Agregar texto"
         Height          =   615
         Left            =   3180
         TabIndex        =   5
         Top             =   240
         Width           =   915
      End
      Begin VB.CommandButton btEliminarLastTxt
         Caption         =   "borra ultimo texto"
         Height          =   615
         Left            =   2220
         TabIndex        =   4
         Top             =   240
         Width           =   915
      End
      Begin VB.CommandButton btEliminarAllTxt
         Caption         =   "borra todos textos"
         Height          =   615
         Left            =   4140
         TabIndex        =   3
         Top             =   240
         Width           =   915
      End
      Begin VB.CommandButton btHatch
         Caption         =   "Sombrear"
         Height          =   615
         Left            =   5100
         TabIndex        =   2
         Top             =   240
         Width           =   915
      End
   End
   Begin MSFlexGridLib.MSFlexGrid Flex
      Height          =   2175
      Left            =   120
      TabIndex        =   0
      Top             =   4560
      Width           =   7215
      _ExtentX        =   12726
      _ExtentY        =   3836
      _Version        =   393216
      Cols            =   7
      FixedCols       =   0
      FocusRect       =   2
      SelectionMode   =   1
      AllowUserResizing=   1
      FormatString    =   $"Form1.frx":0000
   End
   Begin MSComDlg.CommonDialog OpenDwg
      Left            =   6960
      Top             =   6420
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

A continuación el código fuente del programa de prueba.

Option Explicit

Private Comando As String
Private IsDWGOpen As Boolean
Private LastRow As Integer

Private Sub btAgregarTxt_Click()
    Dim myText As String
    Dim e As String
    Dim sx As Double
    Dim sy As Double
    e = Me.MTBViewerX1.SelectEnt
	'Solicita que se seleccione un objeto en el dibujo
    If e <> "" Then
        If Me.MTBViewerX1.GetCentroid(e, sx, sy) = True Then 
		'Obtiene el centroide del objeto
            myText = "Area: " & Me.MTBViewerX1.GetBoundArea(e) & _
		"|" & "Perímetro: " & Me.MTBViewerX1.GetBoundPerimeter(e)
            Me.MTBViewerX1.AddText sx, sy, myText, "|" 
		'Añade un texto al dibujo sobre el objeto
        End If
    End If
End Sub

Private Sub btAreaPerimetro_Click()
    Comando = "AREA&PERIMETRO"
    Me.MTBViewerX1.SelectEnt
End Sub

Private Sub btCloseDWG_Click()
    Me.MTBViewerX1.DwgClose
	    'Cierra el dibujo actual
    Me.lblDwgVersion.Caption = ""
    Me.txtXMLFile.Text = ""
    Me.lblFactorZoom.Caption = ""
    Me.lblZoomAEntidad.Caption = ""
End Sub

Private Sub btDesenlazar_Click()
    Comando = "DESENLAZAR"
    Me.MTBViewerX1.SelectEnt
	'Selecciona una entidad y la desenlaza 
End Sub

Private Sub btEliminarAllTxt_Click()
    Me.MTBViewerX1.DeleteAllTexts
	'Elimina todos los textos añadidos al dibujo
End Sub

Private Sub btEliminarLastTxt_Click()
    Me.MTBViewerX1.DeleteLastText
	'Borra el último texto añadido al dibujo
End Sub

Private Sub btEnlazar_Click()
    Comando = "ENLAZAR"        
    Me.MTBViewerX1.SelectEnt
	'Selecciona una entidad y la enlaza al registro
End Sub

Private Sub btHatch_Click()
        'Selecciona polilíneas y las va coloreando 
    Dim MtrEnts() As String
    Dim k As Integer
    Dim e As String
    k = 0
    Comando = "HATCH"
    ReDim MtrEnts(0)
    e = Me.MTBViewerX1.SelectEnt
    Do While e <> ""
        ReDim Preserve MtrEnts(k)
        MtrEnts(k) = e
        k = k + 1
        e = Me.MTBViewerX1.SelectEnt
    Loop
    For k = LBound(MtrEnts) To UBound(MtrEnts)
        If MtrEnts(k) <> "" Then
            Me.MTBViewerX1.AddHatch MtrEnts(k), k + 1
        End If
    Next k
End Sub

Private Sub btOpenDWG_Click()    'Abre un nuevo dibujo
    Dim fitxer As String
    Dim t1 As Date
    Dim t2 As Date
    On Error Resume Next

    Err.Clear
    Me.lblTimeDWG.Caption = ""
    Me.OpenDwg.CancelError = True
    Me.OpenDwg.FileName = "*.dwg"

    Me.OpenDwg.ShowOpen
    If Err.Number <> 0 Then
        Exit Sub
    End If

    Me.MTBViewerX1.SetUnlockKey ("Put your key code")
    Me.MTBViewerX1.FactorZoom = 0.8
    Me.MTBViewerX1.ZoomAEntidad = False
    fitxer = Me.OpenDwg.FileName
    t1 = Time

    If Me.MTBViewerX1.OpenDwg(fitxer) Then
        t2 = Time
        Me.lblTimeDWG.Caption = CStr(DateDiff("s", t1, t2)) & " segundos."
        Me.lblDwgVersion.Caption = Me.MTBViewerX1.DwgVersion
        Me.txtXMLFile.Text = Me.MTBViewerX1.XMLFile & vbCrLf
        Me.txtXMLFile.Text = Me.txtXMLFile.Text & Me.MTBViewerX1.PRMFile
        Me.lblFactorZoom.Caption = Me.MTBViewerX1.FactorZoom
        CargarParametros
    Else
        MsgBox "Falló la apertura del archivo " & fitxer
        Me.lblDwgVersion.Caption = ""
        Me.txtXMLFile.Text = ""
        ResetParametros
    End If
    IsDWGOpen = True
    Comando = "OPEN"
End Sub

Private Sub CargarParametros()
    'Carga las etiquetas de parámetros con los datos del dibujo
    Me.lblZoomAEntidad.Caption = Me.MTBViewerX1.GetParams_ZoomToEntity
    Me.lblHatchAEntidad.Caption = Me.MTBViewerX1.GetParams_HatchEntity
    Me.lblHatchColor.Caption = Me.MTBViewerX1.GetParams_HatchColor
    Me.lblTextAlign.Caption = Me.MTBViewerX1.GetParams_TextAlign
    Me.lblDecimales.Caption = Me.MTBViewerX1.GetParams_DecimalsCoords
    Me.lblTextColor.Caption = Me.MTBViewerX1.GetParams_TextColor
    Me.lblTextHeight.Caption = Me.MTBViewerX1.GetParams_TextHeight
    Me.lblTextRotation.Caption = Me.MTBViewerX1.GetParams_TextRotation
    Me.lblTextStyle.Caption = Me.MTBViewerX1.GetParams_TextStyle

End Sub

Private Sub ResetParametros()
    'Inicializa todas las etiquetas con parámetros del dibujo
    Me.lblZoomAEntidad.Caption = ""
    Me.lblHatchAEntidad.Caption = ""
    Me.lblHatchColor.Caption = ""
    Me.lblTextAlign.Caption = ""
    Me.lblDecimales.Caption = ""
    Me.lblTextColor.Caption = ""
    Me.lblTextHeight.Caption = ""
    Me.lblTextRotation.Caption = ""
    Me.lblTextStyle.Caption = ""
End Sub

Private Sub CargarGrid()
    'Carga el grid con datos para el dibujo oficinas1.dwg
    Dim Cadenas(5) As String
    Dim i As Integer
    Cadenas(0) = "001" & vbTab & "Juan Palomo" & vbTab & _
	"Contabilidad" & vbTab & "oficinas1.dwg" & vbTab & _
	"2E53" & vbTab & "AcDbPolyline" & vbTab & "1"
    Cadenas(1) = "002" & vbTab & "Juan Miralles" & vbTab & _
	"Tecnico" & vbTab & "oficinas1.dwg" & vbTab & _
	"2CF7" & vbTab & "AcDbPolyline" & vbTab & "22"
    Cadenas(2) = "003" & vbTab & "Marga López" & vbTab & _
	"Comunicaciones" & vbTab & "oficinas1.dwg" & vbTab & _
	"2CD6" & vbTab & "AcDbPolyline" & vbTab & "33"
    Cadenas(3) = "004" & vbTab & "Lucía Pérez" & vbTab & _
	"Comunicaciones" & vbTab & "oficinas1.dwg" & vbTab & _
	"2CDC" & vbTab & "AcDbPolyline" & vbTab & "44"
    Cadenas(4) = "005" & vbTab & "Casimiro Toloveo" & vbTab & _
	"Dirección" & vbTab & "oficinas1.dwg" & vbTab & _
	"2CC6" & vbTab & "AcDbPolyline" & vbTab & "55"
    Cadenas(5) = "006" & vbTab & "Rocío Madrid" & vbTab & _
	"Coordinación" & vbTab & "oficinas1.dwg" & vbTab & _
	"2CFD" & vbTab & "AcDbPolyline" & vbTab & "66"
    Me.Flex.Rows = 1
    For i = LBound(Cadenas) To UBound(Cadenas)
        Me.Flex.AddItem Cadenas(i)
    Next i
End Sub

Private Sub btTematico_Click()
    'Carga textos y sombreados
    Dim i As Integer
    Dim tx As String
    Dim d As String
    Dim e As String
    Dim h As String
    Dim c As Integer
    Dim sx As Double
    Dim sy As Double
    Me.MTBViewerX1.Refresh
    For i = 1 To Me.Flex.Rows - 1
        d = Me.Flex.TextMatrix(i, 3)
        h = Me.Flex.TextMatrix(i, 4)
        e = Me.Flex.TextMatrix(i, 5)
        c = Me.Flex.TextMatrix(i, 6)
        tx = Me.Flex.TextMatrix(i, 0) & "|" & Me.Flex.TextMatrix(i, 1) & _
		"|" & Me.Flex.TextMatrix(i, 2)
        If d = Me.MTBViewerX1.DwgName Then
            If e = "AcDbPolyline" Or e = "AcDb2dPolyline" Then
                If Me.MTBViewerX1.AddHatch(h, c) = False Then
                    MsgBox "Falló el intento de sombrear", _
			vbOKOnly + vbInformation, "Demo"
                    Exit Sub
                End If
            End If
            If Me.MTBViewerX1.GetCentroid(h, sx, sy) = True Then
                Me.MTBViewerX1.AddText sx, sy, tx, "|"
            End If
        End If
    Next i
End Sub

Private Sub btTodosTextos_Click()
    'Carga todos los textos
    Dim i As Integer
    Dim tx As String
    Dim d As String
    Dim e As String
    Dim h As String
    Dim c As Integer
    Dim sx As Double
    Dim sy As Double
    Me.MTBViewerX1.Redraw
    For i = 1 To Me.Flex.Rows - 1
        d = Me.Flex.TextMatrix(i, 3)
        h = Me.Flex.TextMatrix(i, 4)
        e = Me.Flex.TextMatrix(i, 5)
        c = Me.Flex.TextMatrix(i, 6)
        tx = Me.Flex.TextMatrix(i, 0) & "|" & Me.Flex.TextMatrix(i, 1) & "|" & _
		Me.Flex.TextMatrix(i, 2)
        If d = Me.MTBViewerX1.DwgName Then
            If Me.MTBViewerX1.GetCentroid(h, sx, sy) = True Then
                Me.MTBViewerX1.AddText sx, sy, tx, "|"
            End If
        End If
    Next i
End Sub

Private Sub Flex_DblClick()
    Dim d As New ColorDlgACI.ColorDlg
    If Me.Flex.Row >= 1 Then
        d.ColorACI = Me.Flex.TextMatrix(Me.Flex.Row, 6)
        d.ShowColorDlg
        Me.Flex.TextMatrix(Me.Flex.Row, 6) = d.ColorACI
    End If
    Set d = Nothing

End Sub

Private Sub Flex_EnterCell()
    Dim tx As String
    Dim e As String
    Dim d As String
    Dim h As String
    Dim sx As Double
    Dim sy As Double
    If IsDWGOpen = False Then Exit Sub
    d = Me.Flex.TextMatrix(Me.Flex.Row, 3)  'Nombre del dibujo
    h = Me.Flex.TextMatrix(Me.Flex.Row, 4)  'Handle de entidad
    e = Me.Flex.TextMatrix(Me.Flex.Row, 5)  'Tipo de entidad
    If LastRow <> Me.Flex.Row Then
        Me.MTBViewerX1.Redraw
        If d = Me.MTBViewerX1.DwgName Then 'Se trata del mismo dibujo
            'Si hay que señalar la polilínea con un sombreado...
            If Me.OpcHatch(1).Value = True Then
                If e = "AcDbPolyline" Or e = "AcDb2dPolyline" Then
                    Me.MTBViewerX1.AddHatch h, Me.MTBViewerX1.GetParams_HatchColor
                Else
                    Me.MTBViewerX1.ColorSelectBox = 2
                    Me.MTBViewerX1.BoxToEntity h
                End If
            Else
                If Me.OpcHatch(2).Value = True Then
                    Me.MTBViewerX1.ColorSelectBox = 2
                    Me.MTBViewerX1.BoxToEntity h
                End If
            End If
            If Me.chkTextoADibujo.Value = vbChecked Then
                tx = Me.Flex.TextMatrix(Me.Flex.Row, 0) & "|" & _
			Me.Flex.TextMatrix(Me.Flex.Row, 1) & "|" & _
			Me.Flex.TextMatrix(Me.Flex.Row, 2)
                If Me.MTBViewerX1.GetCentroid(h, sx, sy) = True Then
                    Me.MTBViewerX1.AddText sx, sy, tx, "|"
                End If
            End If
        End If
    End If
End Sub

Private Sub Form_Load()
Me.lblVersionX.Caption = Me.MTBViewerX1.GetVersion
	'Obtiene la versión del control

Me.MTBViewerX1.SetUnlockKey "Put your key kode"
CargarGrid
Me.MTBViewerX1.ColorSelectBox = 1
'Indique la ruta donde tiene alojado su archivo de licencia
'Me.MTBViewerX1.PathOfLic = "C:\aaaa\bbb\cccc"
'o indique un código de desbloqueo facilitado por su proveedor
'Me.MTBViewerX1.SetUnlockKey "Write your unlock code"

End Sub

Private Sub MTBViewerX1_ChangedParams()    
    'Se produce cada vez que el usuario cambia los parámetros del dibujo
    CargarParametros
End Sub

'En este evento se realizan las operaciones en función de la variable "Comando"
Private Sub MTBViewerX1_MTBEntitySelected(ByVal DwgName As String, _
		ByVal Handle As String, ByVal EntType As String, _
		ByVal EntLayer As String, ByVal EntColor As Long, _
		ByVal EntLineType As String, ByVal Area As Double, _
		ByVal Length As Double)
  Dim msg As String
  Dim sx As Double
  Dim sy As Double
  Dim i As Integer
    Select Case Comando
        Case "AREA&PERIMETRO"
            msg = "Área: " & Area & vbCr & "Perímetro: " & Length
            MsgBox msg, vbOKOnly + vbInformation, "MTBViewerX"
        Case "ENLAZAR"
            Me.Flex.TextMatrix(Me.Flex.Row, 3) = DwgName
            Me.Flex.TextMatrix(Me.Flex.Row, 4) = Handle
            Me.Flex.TextMatrix(Me.Flex.Row, 5) = EntType
            msg = Me.Flex.TextMatrix(Me.Flex.Row, 0) & "|" & _
		Me.Flex.TextMatrix(Me.Flex.Row, 1) & "|" & _
		Me.Flex.TextMatrix(Me.Flex.Row, 2)
            If Me.MTBViewerX1.GetCentroid(Handle, sx, sy) = True Then
                Me.MTBViewerX1.AddText sx, sy, msg, "|"
            End If
            Comando = ""
        Case "DESENLAZAR"
            For i = 1 To Me.Flex.Rows - 1
                If Me.Flex.TextMatrix(i, 3) = Me.MTBViewerX1.DwgName _
		And Me.Flex.TextMatrix(i, 4) = Handle Then
                    Me.Flex.Row = i
                    Exit For
                End If
            Next i
            Me.Flex.TextMatrix(Me.Flex.Row, 3) = ""
            Me.Flex.TextMatrix(Me.Flex.Row, 4) = ""
            Me.Flex.TextMatrix(Me.Flex.Row, 5) = ""
            Me.MTBViewerX1.Redraw
            Comando = ""
        Case Else
            For i = 1 To Me.Flex.Rows - 1
                If Me.Flex.TextMatrix(i, 3) = Me.MTBViewerX1.DwgName _
		And Me.Flex.TextMatrix(i, 4) = Handle Then
                    Me.Flex.Row = i
                    Me.Flex.SetFocus
                    Exit For
                End If
            Next i
            Comando = ""
    End Select
End Sub

Descárgate el programa de instalación y échale un vistazo al manual del control.

Espero que te de ideas para tus aplicaciones. Pon a prueba el Control ActiveX y ayúdanos a corregirlo y mejorarlo.


 


Código de ejemplo (ZIP):

 

Fichero con el código de ejemplo: MTBViewerX.zip - 5.474 KB
(lo bajarás desde la Web del autor del artículo)

MD5 checksum: C741B64EAC21EC580DA6E526FCFD8F93

 


ir al índice principal del Guille