Programacion VBA para AutoCad 2007 ejemplos

Realizaciónde unejerciciopreliminar
Ahora que ya ha conoce los aspectos básicos de la programación en VBA de AutoCAD, vamos a crear un sencillo ejercicio denominado “Hola a todos”.
En este ejercicio va a crear un dibujo de AutoCAD nuevo, va a añadirle una línea de texto y va a guardarlo, todo ello desde VBA.
Para crear el objeto de texto “Hola a todos”
1. Abra el IDE de VBA ejecutandoel siguientecomandodesde lalíneade comandode AutoCAD:
Comando: VBAIDE
2. Abra laventanade códigoseleccionandolaopciónCódigodel menúVerenel IDEde VBA.
3. Cree un procedimientonuevoenel proyectoseleccionandolaopciónProcedimientoenel menúInsertarenel IDEde VBA.
4. Cuandose le solicite lainformacióndel procedimiento,escribaunnombre,porejemplo, HolaATodos.Asegúrese de que esténseleccionadosel tipo
Procedimientoyel ámbitoPúblico.
5. Pulse Aceptar.
6. Escriba el códigosiguiente(que abre undibujonuevo) entre laslíneas PublicSubHolaatodos() yEnd Sub.
ThisDrawing.Application.Documents.Add
7. Escriba el códigosiguiente(que crealacadenade textoy define el puntodondese inserta) inmediatamente despuésdel códigointroducidoenel paso6.
Dim insPoint(0 To 2) As Double 'Declare insertion point
Dim textHeight As Double 'Declare text height
Dim textStr As String 'Declare text string
Dim textObj As AcadText 'Declare text object
insPoint(0) = 2 'Set insertion point x coordinate
insPoint(1) = 4 'Set insertion point y coordinate
insPoint(2) = 0 'Set insertion point z coordinate
textHeight = 1 'Set text height to 1.0
textString = "Hello, World." 'Set the text string
'Create the Text object
Set textObj = ThisDrawing.ModelSpace.AddText _
(textStr, insPoint, textHeight)
8. Escriba el siguientecódigo(que guardael dibujo) inmediatamentedespuésdel códigointroducidoenel paso7.
ThisDrawing.SaveAs("Hello.dwg")
9. Ejecute el programaseleccionandolaopciónEjecutarSub/UserFormenel menúEjecutardel IDEde VBA.
10. Comandos VBA de AutoCAD

VBAIDE
Abre el IDE de VBA.
El IDE de VBA permite editar, ejecutar y depurar programas de forma interactiva. Aunque sólo se puede activar el IDE de VBA mientras se ejecuta
AutoCAD, es posible minimizarlo, abrirlo y cerrarlo con independencia de la ventana de aplicación de AutoCAD.
VBALOAD
Carga un proyecto VBA en la sesión actual de AutoCAD.
VBARUN
Ejecuta una macro de VBA desde el cuadro de diálogo Macros o desde la línea de comando de AutoCAD.
VBADESCARGAR
Descarga un proyecto VBA de la sesión de AutoCAD actual.
Si el proyecto VBA se ha modificado pero no se ha guardado, se pregunta al usuario si desea guardarlo mediante el cuadro de diálogo Guardar proyecto
(o mediante el equivalente de la línea de comando).
VBAMAN
Muestra el Administrador de VBA, donde puede ver, crear, cargar, cerrar, incrustar y extraer proyectos.
VBAENUN
Ejecuta una secuencia VBA desde la línea de comando de AutoCAD.
Creación de líneas

La línea es el objeto más sencillo de AutoCAD. Pueden crearse diversas líneas, líneas individuales y varios segmentos de línea con o sin arcos. En
general, las líneas se dibujan designando puntos de coordenadas. El tipo de línea por defecto es CONTINUOUS (línea continua), pero hay varios tipos
de línea posibles que utilizan puntos y rayas.
Para crear una línea, utilice uno de los métodos siguientes:
AddLine
Crea una línea que pasa por dos puntos.
AddLightweightPolyline
Crea una polilínea optimizada 2D a partir de una lista de vértices.
AddMLine
Crea una línea múltiple.
AddPolyline
Crea una polilínea 2D o 3D.
Las líneas estándar y las polilíneas se crean en el plano XY del sistema de coordenadas universales. Las polilíneas y las polilíneas optimizadas se crean
en el Sistema de coordenadas de objeto (SCO). Para obtener información acerca de la conversión de coordenadas SCO, véase Conversión de
coordenadas.
Creación de un objeto Polyline
Este ejemplo aplica el método AddLightweightPolyline para crear una polilínea sencilla de dos segmentos utilizando las coordenadas 2D (2,4), (4,2) y
(6,4).
Sub Ch4_AddLightWeightPolyline()
Dim plineObj As AcadLWPolyline
Dim points(0 To 5) As Double
' Define the 2D polyline points
points(0) = 2: points(1) = 4
' Create a light weight Polyline object in model space
Set plineObj = ThisDrawing.ModelSpace. _
AddLightWeightPolyline(points)
ThisDrawing.Application.ZoomAll

End Sub
Creaciónde objetoscurvos
Con AutoCAD podrá crear una amplia variedad de objetos curvos, incluidos círculos, arcos, elipses y curvas spline. Todas las curvas se crean en el
plano XY del SCU actual.
Para crear una curva, utilice uno de los métodos siguientes:
AddArc
Crea un arco contando con el centro, el radio y los ángulos inicial y final.
AddCircle
Crea un círculo con el radio y centro dados.
AddEllipse
Crea una elipse contando con el punto central, un punto en el eje mayor y la proporción del radio.
AddSpline
Crea una curva NURBS (B-spline racional no uniforme) cuadrática o cúbica.
Creación de un objeto Spline
En este ejemplo se crea una curva spline en espacio modelo a partir de tres puntos (0, 0, 0), (5, 5, 0) y (10, 0, 0). La curva tiene las tangentes inicial y
final de (0,5, 0,5, 0,0).
Sub Ch4_CreateSpline()
' This example creates a spline object in model space.
' Declare the variables needed
Dim splineObj As AcadSpline

Dim startTan(0 To 2) As Double
Dim endTan(0 To 2) As Double
Dim fitPoints(0 To 8) As Double
' Define the variables
startTan(0) = 0.5: startTan(1) = 0.5: startTan(2) = 0
endTan(0) = 0.5: endTan(1) = 0.5: endTan(2) = 0
fitPoints(0) = 1: fitPoints(1) = 1: fitPoints(2) = 0
' Create the spline
Set splineObj = ThisDrawing.ModelSpace.AddSpline _
(fitPoints, startTan, endTan)
ZoomAll
End Sub
Para obtener más información acerca de las curvas spline, véase la documentación del objeto Spline y el método AddSpline en ActiveX and VBA
Reference de AutoCAD.
Creaciónde objetosPoint
Los objetos de punto pueden ser de mucha utilidad, por ejemplo, como puntos de referencia o de nodo hacia los cuales podrá forzar el cursor o desfasar
los objetos. Si lo desea, podrá especificar el estilo del punto, así como su tamaño, en relación con la pantalla o en unidades absolutas.
Las variables de sistema PDMODE y PDSIZE controlan el aspecto de los objetos de punto. Los valores 0, 2, 3 y 4 de PDMODE seleccionan una figura
que debe dibujarse a través del punto. El valor 1 establece que no se visualice nada.
Añada 32, 64 o 96 al valor anterior para seleccionar una forma que debe dibujarse alrededor del punto además de la que se dibuja para atravesarlo:

PDSIZE controla el tamaño de las figuras de punto, salvo en los valores 0 y 1 de PDMODE. Al establecer PDSIZE en 0 se genera el punto al 5% de la
altura del área gráfica. Un valor positivo de PDSIZE especifica un tamaño absoluto para las figuras de punto. Un valor negativo se interpreta como un
porcentaje del tamaño de la ventana gráfica. El tamaño de todos los puntos vuelve a calcularse al regenerar el dibujo.
Después de cambiar PDMODE y PDSIZE, la próxima vez que se regenere el dibujo cambiará el aspecto de los puntos existentes.
Para definir PDMODE y PDSIZE, utilice el método SetVariable.
Creación de un objeto Point y modificación de su aspecto
El código siguiente crea un objeto Point en las coordenadas (5, 5, 0) del espacio modelo. Después se actualizan las variables de sistema PDMODE y
PDSIZE.
Sub Ch4_CreatePoint()
Dim pointObj As AcadPoint
Dim location(0 To 2) As Double
' Define the location of the point
location(0) = 5#: location(1) = 5#: location(2) = 0#
' Create the point
Set pointObj = ThisDrawing.ModelSpace.AddPoint(location)
ThisDrawing.SetVariable "PDMODE", 34
ThisDrawing.SetVariable "PDSIZE", 1
ZoomAll
End Sub
Creaciónde áreas con rellenosólido
Es posible crear áreas triangulares y cuadriláteras rellenas de un color. Para obtener resultados más rápidos, estas áreas deben crearse con la variable de
sistema FILLMODE desactivada, y activar de nuevo FILLMODE para rellenar el área terminada.
Cuando se crea un área de relleno sólido cuadrangular, la secuencia de los puntos tercero y cuarto determina su forma. Compare las figuras siguientes:
Los dos primeros puntos definen un lado del polígono. El tercer punto se define diagonalmente contrario al segundo. Si el cuarto punto se define igual
que el tercero, se crea un triángulo relleno.

Para crear un área de relleno sólido, utilice el método AddSolid.
Para obtener más información acerca del relleno de sólidos, véase “Creación de áreas de relleno sólido” en el Manual del usuario.
Creación de un objeto con relleno sólido
El código del ejemplo siguiente crea un cuadrilátero sólido en las coordenadas (0, 0, 0), (5, 0, 0), (5, 8, 0) y (8, 8, 0) del espacio modelo.
Sub Ch4_CreateSolid()
Dim solidObj As AcadSolid
Dim point1(0 To 2) As Double
' Define the solid
point1(0) = 0#: point1(1) = 0#: point1(2) = 0#
' Create the solid object in model space
Set solidObj = ThisDrawing.ModelSpace.AddSolid _
(point1, point2, point3, point4)
ZoomAll
End Sub
Creaciónde regiones
Para crear una región, utilice el método AddRegion Este método crea una región a partir de todos los bucles cerrados formados con la matriz de entrada
de curvas. AutoCAD convierte las polilíneas 2D cerradas y las 3D planas en regiones distintas y, a continuación, convierte las polilíneas, líneas y curvas
que forman bucles planos cerrados. Si más de dos curvas comparten un punto final, puede que la región resultante sea arbitraria. Por esta razón, es
posible que algunas regiones en realidad se creen cuando se utilice el método AddRegion. Utilice una variante que contenga la recién creada matriz de
regiones.
Puede calcular el total de objetos de región creados mediante las funciones UBound y LBound de VBA, como ilustra el siguiente ejemplo:
UBound(objRegions) - LBound(objRegions) + 1
donde objRegions es un variante que contiene el valor de retorno de AddRegion. Esta instrucción calcula el número total de regiones creadas.
Creación de una regiónsimple

El código del ejemplo siguiente crea una región a partir de un círculo.
Sub Ch4_CreateRegion()
' Define an array to hold the
' boundaries of the region.
Dim curves(0 To 0) As AcadCircle
' Create a circle to become a
' boundary for the region.
Dim center(0 To 2) As Double
Dim radius As Double
center(0) = 2
center(1) = 2
center(2) = 0
radius = 5#
Set curves(0) = ThisDrawing.ModelSpace.AddCircle _
(center, radius)
' Create the region
Dim regionObj As Variant
regionObj = ThisDrawing.ModelSpace.AddRegion(curves)
ZoomAll
End Sub
Creaciónde regionescompuestas
Se pueden crear regiones compuestas mediante la sustracción, combinación o localización de la intersección de regiones o sólidos 3D. A continuación,
se pueden extruir o girar las regiones compuestas para crear sólidos complejos. Para crear una región compuesta, utilice el método Boolean.
Cuando se sustrae una región de otra, se llama al método Boolean desde la región primera. Esta es la región de la que debe realizar la sustracción. Por
ejemplo, si desea calcular los metros de alfombrado que necesita para un suelo, llame al método Boolean desde el contorno exterior del suelo y utilice
las zonas que no irán cubiertas con moqueta, como es el caso del espacio que ocupan las columnas o los mostradores, como objeto de la lista de
parámetros de Boolean.
Creación de una regióncompuesta
Sub Ch4_CreateCompositeRegions()
' Create two circles, one representing a room,
' the other a pillar in the center of the room
Dim RoomObjects(0 To 1) As AcadCircle

center(0) = 4
center(1) = 4
center(2) = 0
radius = 2#
Set RoomObjects(0) = ThisDrawing.ModelSpace. _
AddCircle(center, radius)
radius = 1#
Set RoomObjects(1) = ThisDrawing.ModelSpace. _
AddCircle(center, radius)
' Create a region from the two circles
Dim regions As Variant
regions = ThisDrawing.ModelSpace.AddRegion(RoomObjects)
' Copy the regions into the region variables for ease of use
Dim RoundRoomObj As AcadRegion
Dim PillarObj As AcadRegion
If regions(0).Area > regions(1).Area Then
' The first region is the room
Set RoundRoomObj = regions(0)
Set PillarObj = regions(1)
Else
' The first region is the pillar
Set PillarObj = regions(0)
Set RoundRoomObj = regions(1)
End If
' Subtract the pillar space from the floor space to
' get a region that represents the total carpet area.
RoundRoomObj.Boolean acSubtraction, PillarObj
' Use the Area property to determine the total carpet area
MsgBox "The carpet area is: " & RoundRoomObj.Area
End Sub
Calcule el área de la región resultante con la propiedad Area.
Reflexión en simetría de objetos
El reflejo de objetos crea una copia que es la imagen reflejada de un objeto con respecto a un eje o línea de simetría. Se pueden reflejar todos los objetos
de dibujo.
Para reflejar un objeto, utilice el método Mirror. Este método requiere la entrada de dos coordenadas. Las dos coordenadas especificadas se convierten
en puntos finales de la línea de simetría alrededor de la cual se refleja el objeto de base. En 3D, esta línea orienta un plano de simetría perpendicular al
plano XY del SCP que contiene un eje de simetría especificado.

A diferencia del comando de simetría de AutoCAD, este método sitúa en el dibujo la imagen reflejada y mantiene el objeto original. Si desea eliminar el
objeto original, utilice el método Erase.
Para controlar las propiedades de simetría de objetos de texto, utilice la variable de sistema MIRRTEXT. El valor por defecto de MIRRTEXT es
activada (1), con el que la simetría de los objetos de texto se obtiene como la de los demás objetos. Cuando MIRRTEXT está desactivada (0), no se
generan imágenes simétricas de texto. Utilice los métodos GetVariable y SetVariable para consultar y establecer el parámetro MIRRTEXT.
Puede obtener una imagen simétrica de un objeto de ventana gráfica en espacio papel, aunque ello no afecta a la vista de los objetos en el espacio
modelo ni a los objetos de dicho espacio.
Para obtener información acerca del reflejo de objetos, véase “Copia, desfase y reflejo de objetos” en el Manual del usuario.
Reflexión de una polilínea con respecto a un eje
Este ejemplo crea una polilínea optimizada y la refleja con respecto a un eje de simetría. La nueva polilínea es de color azul.
Sub Ch4_MirrorPolyline()
' Create the polyline
plineObj.Closed = True
ZoomAll
' Define the mirror axis

point1(0) = 0: point1(1) = 4.25: point1(2) = 0
' Mirror the polyline
Dim mirrorObj As AcadLWPolyline
Set mirrorObj = plineObj.Mirror(point1, point2)
Dim col As New AcadAcCmColor
Call col.SetRGB(125, 175, 235)
mirrorObj.TrueColor = col
ZoomAll
End Sub
Rotación de objetos
Puede rotar todos los objetos de dibujo y todos los objetos de referencia de atributos.
Para rotar un objeto, utilice el método Rotate del objeto. Este método requiere la entrada de un punto base y de un ángulo de rotación. El punto base es
una matriz de variantes con tres dobles. Estos dobles representan las coordenadas 3D del SCU que indican el punto sobre el que está definido el eje de
rotación. El ángulo de rotación se designa en radianes y determina cuánto rota un objeto alrededor del punto base respecto de su posición actual.
Para obtener más información acerca de la rotación de objetos, véase “Rotación de objetos” en el Manual del usuario.
Rotación de una polilínea con respecto a un punto base
Este ejemplo crea una polilínea optimizada cerrada y después la gira 45 grados con respecto al punto base (4, 4.25, 0).
Sub Ch4_RotatePolyline()

ZoomAll
' Define the rotation of 45 degrees about a
' base point of (4, 4.25, 0)
Dim basePoint(0 To 2) As Double
Dim rotationAngle As Double
basePoint(0) = 4: basePoint(1) = 4.25: basePoint(2) = 0
rotationAngle = 0.7853981 ' 45 degrees
' Rotate the polyline
plineObj.Rotate basePoint, rotationAngle
plineObj.Update
End Sub
Aplicar una escala a los objetos
Se puede atribuir una escala a un objeto si se indican un punto base y una longitud, que se utilizará como factor de escala en función de las unidades de
dibujo actuales. Puede ajustar la escala de todos los objetos de dibujo, así como la de todos los objetos de referencia de atributos.
Para ajustar el factor de escala de un objeto, utilice el método ScaleEntity del objeto. Este método ajusta la misma escala para el objeto en las
direcciones X, Y y Z. Acepta como entrada el punto base de la escala y un factor de escala. El punto base es una matriz de variantes con tres dobles.
Estos dobles representan las coordenadas 3D del SCU que indican el punto donde comienza la escala. El factor de escala es el valor sobre el que se
ajusta la escala del objeto. Las cotas del objeto se multiplican por el factor de escala. Un factor de escala superior al valor 1 amplía el objeto. Un factor
de escala entre 0 y 1 reduce el objeto.

Para obtener más información acerca de la aplicación de escala, véase “Ajuste del tamaño o la forma de los objetos” en el Manual del usuario.
Cambio de la escala de una polilínea
Este ejemplo crea una polilínea optimizada cerrada y después ajusta su escala con un factor 0.5.
Sub Ch4_ScalePolyline()
ZoomAll
' Define the scale
Dim scalefactor As Double
scalefactor = 0.5
' Scale the polyline
plineObj.ScaleEntity basePoint, scalefactor
plineObj.Update
End Sub
Transformación de objetos
Un objeto se puede desplazar, cambiar de escala o rotar con una matriz de transformación de 4 por 4 utilizando el método TransformBy.
En la tabla siguiente se muestra la configuración de la matriz de transformación, donde R = rotación y T = transformación.

Configuración de la matriz de transformación
R00 R01 R02 T0
R10 R11 R12 T1
R20 R21 R22 T2
0 0 0 1
Para transformar un objeto, es necesario inicializar antes la matriz de transformación. En el siguiente ejemplo se muestra una matriz de transformación,
asignada a la variable tMatrix, que rota una entidad 90 grados alrededor del punto (0, 0, 0):
tMatrix(0,0) = 0.0
tMatrix(0,1) = -1.0
tMatrix(0,2) = 0.0
tMatrix(0,3) = 0.0
tMatrix(1,0) = 1.0
tMatrix(1,1) = 0.0
tMatrix(1,2) = 0.0
tMatrix(1,3) = 0.0
tMatrix(2,0) = 0.0
tMatrix(2,1) = 0.0
tMatrix(2,2) = 1.0
tMatrix(2,3) = 0.0
tMatrix(3,0) = 0.0
tMatrix(3,1) = 0.0
tMatrix(3,2) = 0.0
tMatrix(3,3) = 1.0
Una vez terminada la matriz de transformación, debe aplicarse al objeto con el método TransformBy. La siguiente línea de código es una demostración
de cómo se aplica una matriz (tMatrix) a un objeto (anObj):
anObj.TransformBy tMatrix
Rotación de una línea mediante una matriz de transformación
Este ejemplo crea una línea y la gira 90 grados aplicando una matriz de transformación.
Sub Ch4_TransformBy()
' Create a line
Dim lineObj As AcadLine
Dim startPt(0 To 2) As Double
Dim endPt(0 To 2) As Double
startPt(2) = 0
startPt(1) = 1
startPt(2) = 0
endPt(0) = 5

endPt(1) = 1
endPt(2) = 0
Set lineObj = ThisDrawing.ModelSpace. _
AddLine(startPt, endPt)
ZoomAll
' Initialize the transMat variable with a
' transformation matrix that will rotate
' an object by 90 degrees about the point(0,0,0)
Dim transMat(0 To 3, 0 To 3) As Double
transMat(0, 0) = 0#: transMat(0, 1) = -1#
transMat(0, 2) = 0#: transMat(0, 3) = 0#
' Transform the line using the defined transformation matrix
lineObj.TransformBy transMat
lineObj.Update
End Sub
A continuación se presentan otros ejemplos de matrices de transformación:
Matriz de rotación: 90 grados alrededor del punto (0, 0, 0)
0.0 -1.0 0.0 0.0
1.0 0.0 0.0 0.0
0.0 0.0 1.0 0.0
0.0 0.0 0.0 1,0
Matriz de rotación: 45 grados alrededor del punto (5, 5, 0)
0.707107 -0.707107 0.0 5.0
0.707107 0.707107 0.0 -2.071068
0.0 0.0 1.0 0.0
0.0 0.0 0.0 1.0
Matriz de traslación: mueve una entidad en (10, 10, 0)
1.0 0.0 0.0 10.0
0.0 1.0 0.0 10.0
0.0 0.0 1.0 0.0
0.0 0.0 0.0 1.0
Matriz de ajuste de escala: ajuste de escala de 10, 10 en el punto (0, 0, 0)
10.0 0.0 0.0 0.0
0.0 10.0 0.0 0.0

0.0 0.0 10.0 0.0
0.0 0.0 0.0 1.0
10.0 0.0 0.0 -18.0
0.0 10.0 0.0 -18.0
0.0 0.0 10.0 0.0
0.0 0.0 0.0 1.0
Alargamiento y recorte de objetos
Se puede cambiar el ángulo de los arcos y la longitud de las líneas abiertas, arcos, polilíneas abiertas, arcos elípticos y splines abiertas. Se obtiene un
resultado muy parecido al del alargamiento y recorte de objetos.
Los objetos se pueden alargar y recortar si se modifican sus propiedades. Por ejemplo, para alargar una línea, cambie las coordenadas de las propiedades
StartPoint o EndPoint. Para cambiar el ángulo de un arco, modifique las propiedades StartAngle o EndAngle del arco. Después de modificar propiedades
de un objeto, debe utilizarse el método Update para ver los cambios en el dibujo.
Para obtener más información acerca del alargamiento y recorte de objetos, véase “Ajuste del tamaño o la forma de los objetos” en el Manual del
usuario.
Alargar una línea
En este ejemplo se crea una línea y se cambia su punto final, con lo que aumenta su longitud.
Sub Ch4_LengthenLine()
' Define and create the line
Dim startPoint(0 To 2) As Double
Dim endPoint(0 To 2) As Double
startPoint(0) = 0
startPoint(1) = 0
startPoint(2) = 0
endPoint(0) = 1
endPoint(1) = 1
endPoint(2) = 1
Set lineObj = ThisDrawing.ModelSpace. _
AddLine(startPoint, endPoint)

lineObj.Update
' Lengthen the line by changing the
' endpoint to 4, 4, 4
endPoint(0) = 4
endPoint(1) = 4
endPoint(2) = 4
lineObj.endPoint = endPoint
lineObj.Update
End Sub
Descomposición de objetos
La descomposición de objetos fragmenta los objetos individuales en sus partes constitutivas, pero sus efectos no son visibles en la pantalla. Por ejemplo,
la descomposición de formas de lugar a líneas y arcos a partir de polígonos 3D, polilíneas, mallas poligonales y regiones. Sustituye una referencia a
bloque con copias de los objetos simples que componen el bloque.
Para obtener información acerca de la descomposición de objetos, véase “Disociación de objetos compuestos (Descomponer)” en el Manual del usuario.
Descomposición de una polilínea
Este ejemplo crea un objeto de polilínea optimizada. Después la descompone en varios objetos. El ejemplo realiza un bucle en los objetos resultantes y
muestra un cuadro de mensaje que contiene el nombre de todos los objetos y su índice en la lista de objetos descompuestos.
Sub Ch4_ExplodePolyline()
' Create a light weight Polyline object
' Set the bulge on one segment to vary the
' type of objects in the polyline
plineObj.SetBulge 3, -0.5
plineObj.Update
' Explode the polyline
Dim explodedObjects As Variant
explodedObjects = plineObj.Explode

' Loop through the exploded objects
' and display a message box with
' the type of each object
Dim I As Integer
For I = 0 To UBound(explodedObjects)
explodedObjects(I).Update
MsgBox "Exploded Object " & I & ": " & _
explodedObjects(I).ObjectName
explodedObjects(I).Update
Next
End Sub
Edición de polilíneas
Las polilíneas 2D y 3D, los rectángulos, los polígonos y las mallas poligonales 3D son variantes de polilíneas y se editan de la misma manera que ellas.
AutoCAD reconoce tanto las polilíneas ajustadas como las polilíneas ajustadas en forma de splines. Una polilínea ajustada en forma de spline utiliza un
ajuste de curva, similar a una B-spline. Existen dos tipos de polilíneas ajustadas en forma de spline: cuadráticas y cúbicas. Las dos polilíneas están
controladas por la variable de sistema SPLINETYPE. Una polilínea ajustada utiliza curvas estándar para el ajuste de curvas y cualquier dirección
tangente definida en un vértice determinado.
Para modificar una polilínea, utilice las propiedades y los métodos de los objetos LightweightPolyline o Polyline. Para abrir o cerrar una polilínea,
cambiar las coordenadas de un vértice de polilínea o agregar un vértice, utilice los siguientes métodos y propiedades:
Closed (propiedad)
Abre o cierra la polilínea.
Coordinates (propiedad)
Especifica las coordenadas de cada vértice de la polilínea.
AddVertex (método)
Añade un vértice a una polilínea optimizada.
Utilice los siguientes métodos para actualizar la curvatura o la anchura de una polilínea:

SetBulge
Define la curvatura de una polilínea, dado el índice de segmentos.
SetWidth
Define las anchuras inicial y final de una polilínea, dado el índice de segmentos.
Para obtener más información acerca de la modificación de polilíneas, véase “Modificación o unión de polilíneas” en el Manual del usuario.
Modificación de una polilínea
Este ejemplo crea una polilínea optimizada. Después añade una curvatura al tercer segmento de la polilínea, añade un vértice, cambia la anchura del
último segmento y, por último, la cierra.
Sub Ch4_EditPolyline()
' Create a light weight Polyline object
' Add a bulge to segment 3
plineObj.SetBulge 3, -0.5
' Define the new vertex
Dim newVertex(0 To 1) As Double
newVertex(0) = 4: newVertex(1) = 1
' Add the vertex to the polyline
plineObj.AddVertex 5, newVertex
' Set the width of the new segment
plineObj.SetWidth 4, 0.1, 0.5
' Close the polyline
plineObj.Update
End Sub

Modificación de splines
Utilice las siguientes propiedades modificables para cambiar curvas spline:
ControlPoints
Especifica los puntos de apoyo de la spline.
EndTangent
Establece la tangente final de la spline como vector de dirección.
FitPoints
Especifica todos los puntos de ajuste de la spline.
FitTolerance
Vuelve a ajustar la curva Spline a los puntos existentes con los valores de tolerancia nuevos.
Knots
Especifica el vector nodal de la spline.
StartTangent
Especifica la tangente inicial de la spline.
También puede utilizar estos métodos para editar splines:
AddFitPoint
Agrega un punto de ajuste a la spline en el índice indicado.
DeleteFitPoint
Suprime el punto de ajuste de una spline en el índice indicado.

ElevateOrder
Eleva el orden de la spline hasta el orden indicado.
GetFitPoint
Define el punto de ajuste en el índice indicado (sólo un punto de ajuste. (Sólo un punto de ajuste. Para consultar todos los puntos de ajuste de la spline,
utilice la propiedad FitPoints).
Invertir
Invierte la dirección de la spline.
SetControlPoint
Define el punto de apoyo de la spline en el índice indicado.
SetFitPoint
Define el punto de ajuste en el índice indicado. (Sólo un punto de ajuste. Para consultar todos los puntos de ajuste de la spline, utilice la propiedad
FitPoints).
SetWeight
Define el grosor del punto de apoyo en un índice dado.
Utilice las siguientes propiedades de sólo lectura para consultar splines:
Area
Obtiene el área cerrada de una spline.
Closed
Indica si la spline está abierta o cerrada.
Degree
Obtiene el grado de la representación polinómica de la spline.

IsPeriodic
Especifica si la spline dada es periódica.
IsPlanar
Especifica si la spline dada es plana.
IsRational
Especifica si la spline dada es racional.
NumberOfControlPoints
Obtiene el número de puntos de apoyo de la spline.
NumberOfFitPoints
Obtiene el número de puntos de ajuste de la spline.
Para obtener más información acerca de la modificación de curvas spline, véase “Modificación de splines” en el Manual del usuario.
Modificación de un punto de apoyo en una curva spline
Este ejemplo crea una curva spline y cambia su primer punto de apoyo.
Sub Ch4_ChangeSplineControlPoint()
' Create the spline
Set splineObj = ThisDrawing.ModelSpace. _
AddSpline(fitPoints, startTan, endTan)
splineObj.Update
' Change the coordinate of the first fit point
Dim controlPoint(0 To 2) As Double
controlPoint(0) = 0

controlPoint(1) = 3
controlPoint(2) = 0
splineObj.SetControlPoint 0, controlPoint
splineObj.Update
End Sub
Definición de coordenadas 3D
Introducir coordenadas 3D en el sistema de coordenadas universales (SCU) es similar a introducir coordenadas 2D en dicho sistema. Además de
especificar los valores X e Y, el usuario especifica un valor Z. Al igual que ocurre con las coordenadas 2D, se utiliza una variante para pasar las
coordenadas a los métodos y propiedades ActiveX® y para consultar las coordenadas.
Para obtener más información acerca de la definición de coordenadas 3D, véase “Introducción de coordenadas 3D“ en el Manual del usuario.
Definición y consulta de coordenadas en polilíneas 2D y 3D
En este ejemplo se crean dos polilíneas, cada una con tres coordenadas. La primera es una polilínea 2D y la segunda 3D. Observe que la longitud de la
matriz que contiene los vértices está ampliada para incluir las coordenadas Z en la creación de la polilínea 3D. El ejemplo termina con la consulta de las
coordenadas de las polilíneas, que se muestran en un cuadro de mensaje.
Sub Ch8_Polyline_2D_3D()
Dim pline2DObj As AcadLWPolyline
Dim pline3DObj As AcadPolyline
Dim points2D(0 To 5) As Double
Dim points3D(0 To 8) As Double
' Define three 2D polyline points
points2D(0) = 1: points2D(1) = 1
' Define three 3D polyline points
points3D(0) = 1: points3D(1) = 1: points3D(2) = 0
' Create the 2D light weight Polyline
Set pline2DObj = ThisDrawing.ModelSpace. _
AddLightWeightPolyline(points2D)
pline2DObj.Color = acRed
pline2DObj.Update
' Create the 3D polyline
Set pline3DObj = ThisDrawing.ModelSpace. _
AddPolyline(points3D)

pline3DObj.Color = acBlue
pline3DObj.Update
' Query the coordinates of the polylines
Dim get2Dpts As Variant
Dim get3Dpts As Variant
get2Dpts = pline2DObj.Coordinates
get3Dpts = pline3DObj.Coordinates
' Display the coordinates
MsgBox ("2D polyline (red): " & vbCrLf & _
get2Dpts(0) & ", " & get2Dpts(1) & vbCrLf & _
get2Dpts(2) & ", " & get2Dpts(3) & vbCrLf & _
get2Dpts(4) & ", " & get2Dpts(5))
MsgBox ("3D polyline (blue): " & vbCrLf & _
get3Dpts(0) & ", " & get3Dpts(1) & ", " & _
get3Dpts(2) & vbCrLf & _
get3Dpts(3) & ", " & get3Dpts(4) & ", " & _
get3Dpts(5) & vbCrLf & _
get3Dpts(6) & ", " & get3Dpts(7) & ", " & _
get3Dpts(8))
End Sub
Definiciónde unsistemade coordenadaspersonales
Puede definir un sistema de coordenadas personales ( SCP ) para cambiar el emplazamiento del punto de origen (0, 0, 0) y la orientación del plano XY y
del eje Z. Un SCP se puede colocar y orientar en cualquier punto del espacio tridimensional. Se pueden definir, guardar y utilizar tantos sistemas de
coordenadas como se necesiten. La introducción y visualización de las coordenadas depende del sistema SCP que esté activo.
Para indicar el origen y la orientación del SCP, puede mostrar el icono SCP en el punto de origen del SCP mediante la propiedad UCSIconAtOrigin. Si
el icono SCP está activado (véase la propiedad UCSIconOn) pero no aparece en el origen, se muestra en la coordenada del SCU definida por la variable
de sistema UCSORG.
Puede crear un sistema de coordenadas personales con el método Add. Este método requiere cuatro valores de entrada: la coordenada del origen, una
coordenada en los ejes X e Y, y el nombre del SCP.
Todas las coordenadas de ActiveX Automation de AutoCAD® se introducen en el sistema de coordenadas universales. Utilice el método GetUCSMatrix
para volver a la matriz de transformación de un SCP concreto. Utilice esta matriz de transformación para buscar las coordenadas SCU equivalentes.
Para activar un SCP, utilice la propiedad ActiveUCS del objeto Document. Si se realizan cambios en el SCP activo, el nuevo objeto de SCP debe
restablecerse como SCP activo para que los cambios se vean. Para restablecer el SCP activo, sólo hay que llamar a la propiedad ActiveUCS de nuevo
con el objeto de SCP actualizado.

Para obtener más información sobre la definición del SCP, véase “Control del sistema de coordenadas personales (SCP) en 3D” en el Manual del
usuario.
Creación de un SCP nuevo, activación y traducción de las coordenadas de un punto a SCP
La siguiente subrutina crea un nuevo SCP y lo establece como el SCP activo del dibujo. A continuación, pide al usuario que designe un punto del dibujo
y devuelve las coordenadas SCU y SCP del punto.
Sub Ch8_NewUCS()
' Define the variables we will need
Dim ucsObj As AcadUCS
Dim origin(0 To 2) As Double
Dim xAxisPnt(0 To 2) As Double
Dim yAxisPnt(0 To 2) As Double
' Define the UCS points
origin(0) = 4: origin(1) = 5: origin(2) = 3
xAxisPnt(0) = 5: xAxisPnt(1) = 5: xAxisPnt(2) = 3
yAxisPnt(0) = 4: yAxisPnt(1) = 6: yAxisPnt(2) = 3
' Add the UCS to the
' UserCoordinatesSystems collection
Set ucsObj = ThisDrawing.UserCoordinateSystems. _
Add(origin, xAxisPnt, yAxisPnt, "New_UCS")
' Display the UCS icon
ThisDrawing.ActiveViewport.UCSIconAtOrigin = True
ThisDrawing.ActiveViewport.UCSIconOn = True
' Make the new UCS the active UCS
ThisDrawing.ActiveUCS = ucsObj
MsgBox "The current UCS is : " & ThisDrawing.ActiveUCS.Name _
& vbCrLf & " Pick a point in the drawing."
' Find the WCS and UCS coordinate of a point
Dim WCSPnt As Variant
Dim UCSPnt As Variant
WCSPnt = ThisDrawing.Utility.GetPoint(, "Enter a point: ")
UCSPnt = ThisDrawing.Utility.TranslateCoordinates _
(WCSPnt, acWorld, acUCS, False)
MsgBox "The WCS coordinates are: " & WCSPnt(0) & ", " _
& WCSPnt(1) & ", " & WCSPnt(2) & vbCrLf & _
"The UCS coordinates are: " & UCSPnt(0) & ", " _
& UCSPnt(1) & ", " & UCSPnt(2)
End Sub
Creación de una malla poligonal

En este ejemplo se crea una malla poligonal de “. La dirección de la ventana gráfica activa se ajusta de forma que la naturaleza tridimensional de la
malla se visualiza con más facilidad.
Sub Ch8_Create3DMesh()
Dim meshObj As AcadPolygonMesh
Dim mSize, nSize, Count As Integer
' create the matrix of points
points(0) = 0: points(1) = 0: points(2) = 0
mSize = 4: nSize = 4
' creates a 3Dmesh in model space
Set meshObj = ThisDrawing.ModelSpace. _
Add3DMesh(mSize, nSize, points)
' Change the viewing direction of the viewport
' to better see the cylinder
Dim NewDirection(0 To 2) As Double
NewDirection(0) = -1
NewDirection(2) = 1
ThisDrawing.ActiveViewport.direction = NewDirection
ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
ZoomAll
End Sub
Creación de una malla policara
En este ejemplo se crea una malla policara en espacio modelo. Después se actualiza la dirección de visualización de la ventana gráfica activa para
permitir una mejor visión de la naturaleza tridimensional de la malla.
Sub Ch8_CreatePolyfaceMesh()

'Define the mesh vertices
Dim vertex(0 To 17) As Double
vertex(0) = 4: vertex(1) = 7: vertex(2) = 0
' Define the face list
Dim FaceList(0 To 7) As Integer
FaceList(0) = 1
FaceList(1) = 2
FaceList(2) = 5
FaceList(3) = 4
FaceList(4) = 2
FaceList(5) = 3
FaceList(6) = 6
FaceList(7) = 5
' Create the polyface mesh
Dim polyfaceMeshObj As AcadPolyfaceMesh
Set polyfaceMeshObj = ThisDrawing.ModelSpace.AddPolyfaceMesh _
(vertex, FaceList)
' Change the viewing direction of the viewport to
' better see the polyface mesh
NewDirection(2) = 1
ZoomAll
End Sub
Creación de una cuña sólida
En el siguiente ejemplo se crea un sólido con forma de cuña en espacio modelo. Después se actualiza la dirección de visualización de la ventana gráfica
activa para permitir una mejor visión de la naturaleza tridimensional de la cuña.
Sub Ch8_CreateWedge()
Dim wedgeObj As Acad3DSolid
Dim length As Double
Dim width As Double
Dim height As Double
' Define the wedge
center(0) = 5#: center(1) = 5#: center(2) = 0

length = 10#: width = 15#: height = 20#
' Create the wedge in model space
Set wedgeObj = ThisDrawing.ModelSpace. _
AddWedge(center, length, width, height)
NewDirection(2) = 1
ZoomAll
End Sub
Modificación de sólidos 3D
Una vez creado un sólido, puede proceder a la creación de formas sólidas más complejas mediante la combinación de distintos objetos sólidos. Puede
optar por unir sólidos, sustraerlos o localizar su volumen común (partes superpuestas). Utilice el método Boolean o CheckInterference para efectuar
dichas combinaciones.
Los sólidos se pueden modificar también mediante la obtención de la sección transversal bidimensional de un sólido o el corte de un sólido en dos
partes. Utilice el método SectionSolid para buscar secciones transversales de sólidos, y el método SliceSolid para cortar un sólido en dos partes.
Búsqueda de la interferencia entre dos sólidos
En este ejemplo se crea un prisma rectangular y un cilindro en espacio modelo. A continuación, se localiza la interferencia entre los dos sólidos y se crea
un sólido nuevo a partir de ella. Para facilitar la visualización, el prisma se colorea en blanco, el cilindro en cián y el sólido de interferencia en rojo.
Sub Ch8_FindInterferenceBetweenSolids()
' Define the box
Dim boxObj As Acad3DSolid
Dim width As Double

center(0) = 5: center(1) = 5: center(2) = 0
length = 5
width = 7
height = 10
' Create the box object in model space
' and color it white
Set boxObj = ThisDrawing.ModelSpace. _
AddBox(center, length, width, height)
boxObj.Color = acWhite
' Define the cylinder
Dim cylinderObj As Acad3DSolid
Dim cylinderRadius As Double
Dim cylinderHeight As Double
cylinderRadius = 5
cylinderHeight = 20
' Create the Cylinder and
' color it cyan
Set cylinderObj = ThisDrawing.ModelSpace.AddCylinder _
(center, cylinderRadius, cylinderHeight)
cylinderObj.Color = acCyan
' Find the interference between the two solids
' and create a new solid from it. Color the
' new solid red.
Dim solidObj As Acad3DSolid
Set solidObj = boxObj.CheckInterference(cylinderObj, True)
solidObj.Color = acRed
ZoomAll
End Sub
Corte de un sólido en dos sólidos
En este ejemplo se crea un prisma rectangular en espacio modelo. Después se corta tomando como referencia un plano definido por tres puntos. La
sección se devuelve como sólido 3D.
Sub Ch8_SliceABox()
' Create the box object
Dim width As Double
length = 5#: width = 7: height = 10#
' Create the box (3DSolid) object in model space
Set boxObj = ThisDrawing.ModelSpace. _
AddBox(center, length, width, height)

boxObj.Color = acWhite
' Define the section plane with three points
Dim slicePt1(0 To 2) As Double
slicePt1(0) = 1.5: slicePt1(1) = 7.5: slicePt1(2) = 0
' slice the box and color the new solid red
Dim sliceObj As Acad3DSolid
Set sliceObj = boxObj.SliceSolid _
(slicePt1, slicePt2, slicePt3, True)
sliceObj.Color = acRed
ZoomAll
End Sub
Diseñar el camino del jardín - Aprendizaje de ActiveX/VBA
Este aprendizaje muestra cómo utilizar ActiveX y Visual Basic para Aplicaciones (VBA) y cómo añadir una macro a AutoCAD. Se orienta hacia la
arquitectura paisajística, pero los conceptos que contiene se pueden aplicar a cualquier especialidad.
Este Aprendizaje está destinado al usuario avanzado de AutoCAD que a su vez es principiante en programación VBA.
Temas de esta sección:
 Inspeccionar el entorno
 Definir el objetivo
 La primera función
 Obtención de datos
 Dibujo del contorno del camino
 Dibujo de las losetas
 Integración de los elementos
 Ejecución del código paso a paso
 Ejecución de la macro
 Adición de interfaz de cuadro de diálogo
Inspeccionar el entorno

Para el aprendizaje, necesitará el entorno de desarrollo integrado de VBA (VBA IDE) de AutoCAD®. VBA IDE se instala automáticamente con la
opción de instalación Completa del programa de instalación de AutoCAD. Si seleccionó la opción de instalación Personalizada en el momento de
instalar AutoCAD, VBA IDE puede no haberse instalado. Es posible que tenga que instalarlo ejecutando de nuevo el programa de instalación de
AutoCAD.
Para comprobar si VBA IDE está instalado
1. Inicie AutoCAD.
2. En la línea de comando, escriba vbaide y pulse INTRO.
Si se abre VBA IDE, esto significa que está instalado. Si aparece el mensaje “AutoCAD VBA no se encuentra instalado”, VBA IDE no está
instalado.
Definir el objetivo
El objetivo de este aprendizaje es desarrollar una nueva macro para AutoCAD que dibuje el camino de un jardín y lo rellene con losetas circulares de
cemento. La nueva macro tendrá la siguiente secuencia de solicitudes:
Command: gardenpath
Punto inicial del camino: El usuario especificará el punto inicial
Punto final del camino: El usuario especificará el punto final
Mitad de la anchura del camino: El usuario especificará un número
Radio de las losetas: El usuario especificará un número
Espacio entre las losetas: El usuario especificará un número
En primer lugar, la macro solicitará al usuario que especifique los puntos inicial y final que determinarán la línea de centro del camino. Luego, solicitará
al usuario que especifique la mitad de la anchura del camino y el radio de las losetas circulares. Finalmente, el usuario especificará el espacio entre las
losetas. Usará la mitad de la anchura del camino en vez de la anchura completa puesto que es más fácil visualizar la mitad de la anchura desde la línea de
centro del camino.

La primera función
La macro Gardenpath se desarrolla utilizando una serie de funciones y subrutinas. Muchas subrutinas requieren la manipulación de ángulos. Puesto que
ActiveX especifica ángulos en radianes, pero la mayoría de los usuarios utiliza grados para medir ángulos, comenzaremos por crear una función que
convierta grados a radianes.
Para convertir grados a radianes
1. En la línea de comando, escriba vbaide y pulse INTRO.
2. En VBA IDE, en el menú Ver, pulse Código para abrir la ventana Código.
3. Escriba el siguiente código en la ventana Código:
Const pi = 3.14159
' Conversión de un ángulo en grados a radianes
Function dtr(a As Double) As Double
dtr = (a / 180) * pi
End Function
Observe que tan pronto como se pulsa INTRO después de escribir la línea Function dtr(a As Double) As Double,End Function se añade
automáticamente. Esto garantiza que todas las subrutinas y funciones tienen una instrucción End asociada.
Ahora revise el código. Primero, la constante pi se define con el valor de 3.14159. Esto permite que se utilice la palabra pi en lugar de tener que
teclear 3.14159 cada vez que vaya a usar el valor.
A continuación, define una función llamada dtr (abreviación de grados a radianes). La función dtr toma un argumento, a, que es el ángulo en
grados. El resultado se obtiene dividiendo el ángulo en grados por 180 y, a continuación, multiplicando su valor por pi. La línea que comienza
por una comilla simple es un comentario. VBA ignora todo el texto que haya en una línea después de una comilla simple.
Ahora esta función puede utilizarse en otras subrutinas de todo el proyecto
4. Guarde su trabajo. Pulse Archivo » Guardar Global1. Escriba gardenpath.dvb como nombre del proyecto.
A continuación, añadirá una función para calcular la distancia entre puntos.
Para calcular la distancia entre dos puntos
1. Escriba el siguiente código después de la función dtr:
' Cálculo de la distancia entre dos puntos

Function distance(sp As Variant, ep As Variant) _
As Double
Dim x As Double
Dim y As Double
Dim z As Double
x = sp(0) - ep(0)
y = sp(1) - ep(1)
z = sp(2) - ep(2)
distance = Sqr((Sqr((x ^ 2) + (y ^ 2)) ^ 2) + (z ^ 2))
End Function
2. Guarde su trabajo.
Obtención de datos
La macro Gardenpath pregunta al usuario dónde debe dibujarse el camino, qué anchura debe tener, de qué tamaño son las losetas de cemento y cuál es el
espacio entre éstas. Ahora definirá una subrutina que solicita al usuario todos estos datos y que calcula diversos números que se utilizarán en el resto de
la macro.
En esta subrutina, utilizará los métodos de entrada de datos de usuario del objeto Utility.
 Declaración de variables
 Escritura de la subrutina gpuser
 Declaración de variables
La siguiente subrutina utiliza diversas variables. Todas las variables deben declararse previamente para que la subrutina pueda acceder a ellas.
En VBA IDE, escriba el siguiente código en la ventana Código, inmediatamente después de la línea Const pi = 3.14159:
Private sp(0 To 2) As Double
Private ep(0 To 2) As Double

Private hwidth As Double
Private trad As Double
Private tspac As Double
Private pangle As Double
Private plength As Double
Private totalwidth As Double
Private angp90 As Double
Private angm90 As Double
Ahora observe las dos listas desplegables de la parte superior de la ventana Código. Estas listas se denominan cuadro Objeto y cuadro
Procedimiento/Evento y actualmente muestran respectivamente los términos (General) y (Declaraciones). Estas listas muestran la sección del código en
la que está trabajando en este momento, y le permiten desplazarse rápidamente a otra sección simplemente seleccionándola en la lista. La sección
(Declaraciones) es el lugar apropiado para declarar variables que va a utilizar en más de una subrutina.
Escritura de la subrutina gpuser
La subrutina gpuser solicita al usuario la información necesaria para dibujar un camino de jardín. Escriba lo siguiente después de la función distance:
' Adquisición de información para el camino del jardín
Private Sub gpuser()
Dim varRet As Variant
varRet = ThisDrawing.Utility.GetPoint( _
, "Punto inicial del camino: ")
sp(0) = varRet(0)
sp(1) = varRet(1)
sp(2) = varRet(2)
varRet = ThisDrawing.Utility.GetPoint( _
, "Punto final del camino: ")
ep(0) = varRet(0)
ep(1) = varRet(1)
ep(2) = varRet(2)
hwidth = ThisDrawing.Utility. _
GetDistance(sp, "Mitad de anchura del camino: ")
trad = ThisDrawing.Utility. _
GetDistance(sp, "Radio de las losetas: ")
tspac = ThisDrawing.Utility. _
GetDistance(sp, "Espacio entre losetas: ")
pangle = ThisDrawing.Utility.AngleFromXAxis( _
sp, ep)
totalwidth = 2 * hwidth
plength = distance(sp, ep)
angp90 = pangle + dtr(90)

angm90 = pangle - dtr(90)
End Sub
En la subrutina gpuser, la línea Dim varRet As Variant declara la variable varRet. Puesto que esta variable se utiliza solamente en esta subrutina, puede
declararse aquí localmente, en vez de hacerlo en la sección (Declaraciones).
La siguiente línea, varRet = ThisDrawing.Utility.GetPoint( , "Punto inicial del camino: "), llama al método GetPoint. El carácter de subrayado sirve para
que una línea larga sea más fácil de leer, ya que indica a VBA que debe leer esa línea y la siguiente como si formaran una sola línea. El carácter de
subrayado puede eliminarse colocando todo el código en una única línea.
Para acceder al método GetPoint, antes debe ir al objeto ThisDrawing que representa el dibujo actual. Después de escribir ThisDrawing se escribe un
punto (.), lo que significa que va a acceder a algo que hay dentro de ese objeto. Después del punto, se escribe Utility y otro punto. Una vez más, va a
acceder a algo que hay dentro del objeto Utility. Finalmente, escriba GetPoint, que es el nombre del método que se está invocando.
El método GetPoint toma dos parámetros. El primer parámetro es opcional y no se utilizará. Deje el parámetro en blanco y escriba únicamente una coma
para marcar su ubicación. El segundo parámetro es la solicitud, que también es opcional. Para este parámetro, ha escrito una cadena que solicita al
usuario que especifique el punto inicial. El punto especificado por el usuario se coloca en la variable varRet. Las tres líneas siguientes de la subrutina
copian el punto devuelto por el usuario en la matriz sp.
El punto final se obtiene de la misma forma.
El método GetDistance se utiliza para obtener la mitad de la anchura del camino (hwidth), el radio de las losetas (trad), y el espacio entre éstas (tspac).
El método GetDistance utiliza dos parámetros. El primer parámetro es un punto base. Para este valor, usted determina el punto inicial. El segundo
parámetro es la solicitud, para la que proporciona una cadena que solicita al usuario el dato correspondiente. Lo interesante acerca del método
GetDistance es que puede devolver tanto un valor escrito en la línea de comando como la distancia entre el punto inicial y un punto seleccionado en
AutoCAD.
La subrutina continua calculando diversas variables utilizadas más tarde en la macro. La variable pangle se define con el ángulo entre los puntos inicial
y final y se halla utilizando el método AngleFromXAxis. La anchura del camino se halla multiplicando la mitad de la anchura por dos. La variable
plength se define como la longitud del camino y se halla utilizando la función distancia escrita anteriormente. Finalmente, se calcula y se guarda el
ángulo del camino más y menos 90 grados en angp90 y angm90, respectivamente.
La siguiente ilustración muestra la forma en la que las variables obtenidas por gpuser especifican las dimensiones del camino.

Dibujo del contorno del camino
Ahora que ha obtenido la ubicación y la anchura del camino, puede dibujar su contorno. Añada el siguiente código bajo la subrutina gpuser:
' Dibujo del contorno del camino
Private Sub drawout()
Dim pline As AcadLWPolyline
varRet = ThisDrawing.Utility.PolarPoint( _
sp, angm90, hwidth)
points(0) = varRet(0)
varRet, pangle, plength)
varRet, angp90, totalwidth)

varRet, pangle + dtr(180), plength)
Set pline = ThisDrawing.ModelSpace. _
End Sub
Esta subrutina dibuja el contorno del camino utilizando el método AddLightweightPolyline. Este método requiere un parámetro: una matriz de puntos
que genere la polilínea. Debe hallar todos los puntos que forman el objeto de polilínea y colocarlos en una matriz en el orden en que deben dibujarse.
Para esta polilínea, los puntos necesarios son los vértices del camino.
Para hallar los vértices del camino, utilice el método PolarPoint. Este método encuentra un punto que está a un ángulo y una distancia determinados
desde un punto base. Comience por el punto inicial (sp) y encuentre el primer vértice del camino trabajando en dirección contraria a las agujas del reloj.
Este vértice estará a una distancia equivalente a la mitad de la anchura del camino (hwidth) y a -90 grados del ángulo del camino. Puesto que desea
dibujar un rectángulo cerrado para el camino, ese punto se convierte en el primer y último punto de la matriz. Por lo tanto, las coordenadas X e Y
obtenidas con el método PolarPoint se desplazan a la primera y a la última posición de la matriz de puntos.
Los restantes vértices del camino se hallan de la misma forma utilizando la longitud y la anchura del camino (plength y width), y el ángulo del camino.
Cada vez que se invoca el método PolarPoint, las coordenadas obtenidas (varRet) se copian en la matriz de puntos.
Una vez identificados los vértices en la matriz de puntos, se invoca el método AddLightweightPolyline. Observe que este método es invocado desde el
objeto ModelSpace. Si ejecutara esta macro, vería que la polilínea todavía no es visible en AutoCAD. La polilínea no será visible hasta que actualice la
visualización, cosa que hará má
Dibujo de las losetas
Ahora que se ha desarrollado la subrutina de entrada de datos de usuario y la subrutina para dibujar el contorno, ya se puede rellenar el camino con
losetas circulares. Esta tarea requiere algo de geometría.
En VBA IDE, escriba el siguiente código en la ventana Código, después de la rutina drawout:
' Colocación de una hilera de losetas a lo largo de la distancia dada del camino
' y posiblemente desfase de ésta
Private Sub drow(pd As Double, offset As Double)
Dim pfirst(0 To 2) As Double
Dim pctile(0 To 2) As Double

Dim pltile(0 To 2) As Double
Dim cir As AcadCircle
sp, pangle, pd)
pfirst(0) = varRet(0)
pfirst, angp90, offset)
pctile(0) = varRet(0)
pltile(0) = pctile(0)
Do While distance(pfirst, pltile) < (hwidth - trad)
Set cir = ThisDrawing.ModelSpace.AddCircle( _
pltile, trad)
pltile, angp90, (tspac + trad + trad))
pltile(0) = varRet(0)
Loop
pctile, angm90, tspac + trad + trad)
Do While distance(pfirst, pltile) < (hwidth - trad)
Set cir = ThisDrawing.ModelSpace.AddCircle( _
pltile, trad)
pltile, angm90, (tspac + trad + trad))
Loop
End Sub
' Dibujo de las hileras de losetas
Private Sub drawtiles()
Dim pdist As Double
Dim offset As Double
pdist = trad + tspac
offset = 0
Do While pdist <= (plength - trad)
drow pdist, offset
pdist = pdist + ((tspac + trad + trad) * Sin(dtr(60)))

If offset = 0 Then
offset = (tspac + trad + trad) * Cos(dtr(60))
Else
offset = 0
End If
Loop
End Sub
Para comprender cómo funcionan estas subrutinas, consulte la siguiente ilustración. La subrutina drow dibuja una hilera de losetas a una distancia dada a
lo largo del camino especificada por su primer argumento, y desfasa la hilera perpendicularmente al camino con una distancia especificada por el
segundo argumento. Se desea desfasar las losetas en hileras alternas para que cubran más espacio y se distribuyan de forma más estética.
La subrutina drow halla la ubicación de la primera hilera mediante el método PolarPoint para desplazarla a lo largo del camino con la distancia
especificada por el primer argumento. La subrutina vuelve a utilizar entonces el método PolarPoint para desplazarse perpendicularmente al camino para
efectuar el desfase. La subrutina utiliza la instrucción While para continuar dibujando círculos hasta que se encuentra el final del camino. El método
PolarPoint de la primera instrucción While se desplaza a la siguiente posición de loseta creando un espacio equivalente a dos radios de loseta (trad) más
un espacio entre losetas (tspac). El segundo bucle while dibuja entonces las losetas de la hilera en la otra dirección hasta que se encuentra el otro borde.
La subrutina drawtiles invoca drow repetidamente hasta que se dibujan todas las hileras de losetas. La subrutina While loop recorre paso a paso el
camino, invocando drow para cada hilera. Las losetas de las hileras adyacentes forman triángulos equiláteros, tal como se muestra en la ilustración
anterior. Las aristas de estos triángulos equivalen al doble del radio de la loseta más el espacio entre losetas. Por lo tanto, por la trigonometría, la
distancia a lo largo del camino entre hileras es el seno de 60 grados multiplicado por esta cantidad, y el desfase de las hileras impares es el coseno
sesenta grados multiplicado por esta cantidad.
La instrucción If se utiliza en drawtiles para desfasar hileras alternas. Si el desfase es igual a 0, defínalo como el espacio entre los centros de las hileras
multiplicadas por el coseno de 60 grados, tal como se explicó anteriormente. Si el desfase no es igual a 0, establézcalo en 0. Esto alterna el desfase de las
hileras de la forma deseada.

Guarde su trabajo.
Integración de los elementos
Ahora ya es posible combinar las subrutinas en la macro Gardenpath. En VBA IDE escriba el siguiente código en la ventana Código, después de la
subrutinadrawtiles:
' Ejecución del comando, invocando las funciones constituyentes
Sub gardenpath()
Dim sblip As Variant
Dim scmde As Variant
gpuser
sblip = ThisDrawing.GetVariable("blipmode")
scmde = ThisDrawing.GetVariable("cmdecho")
ThisDrawing.SetVariable "blipmode", 0
ThisDrawing.SetVariable "cmdecho", 0
drawout
drawtiles
ThisDrawing.SetVariable "blipmode", sblip
ThisDrawing.SetVariable "cmdecho", scmde
End Sub
La subrutinapath invocagpuser para obtener la entrada de los datos necesarios. El método GetVariable se utiliza entonces para obtener los valores
actuales de las variables de sistema BLIPMODE y CMDECHO y guarda estos valores como sblip y scmde. La subrutina utiliza entonces el método
SetVariable para establecer ambas variables de sistema en 0, desactivando marcas auxiliares y eco de comandos. A continuación, se dibuja el camino
usando las subrutinas drawout y drawtiles. Finalmente, se utiliza el método SetVariable para restablecer el valor original de las variables de sistema.
Como puede verse, ésta es la única subrutina, entre las que ha escrito, que no comienza con la palabra clave Private, que garantiza que la subrutina sólo
puede invocarse desde el módulo actual. Puesto que la subrutina gardenpath debe estar disponible para el usuario, debe omitirse la palabra clave Private.
Guarde su trabajo.
Ejecución del código paso a paso
Ahora ejecute la macro, recorriendo el código paso a paso a medida que se ejecuta.
En el menú Herr. de AutoCAD, pulse Macro » Macros. En el cuadro de diálogo Macros, seleccione ThisDrawing.gardenpath y pulse Entrar.

VBA IDE aparecerá en primer plano en la pantalla, y la primera línea de la macro gardenpath aparecerá resaltada. La línea resaltada es la línea de código
que está apunto de ejecutarse. Para ejecutar la línea, pulse F8. La siguiente línea de código que debe ejecutarse es la subrutina gpuser. Para ejecutar paso
a paso la subrutina gpuser vuelva a pulsar F8.
Ahora está al principio de la rutina gpuser. Pulse F8 una vez más para resaltar el primer método GetPoint. Antes de ejecutar esta línea abra la ventana
Locales pulsando Ver » Ventana Locales. Esta ventana se muestra en la parte inferior de VBA IDE. Todas las variables locales y sus valores se muestran
en la ventana Locales mientras se ejecuta la macro.
Ahora pulse F8 para ejecutar el método GetPoint. Observe que el resaltado desaparece y no se presenta nuevo código. Esto es porque el método
GetPoint está esperando a que el usuario especifique un punto en AutoCAD. Vuelva a la ventana de AutoCAD. Verá la solicitud que ha especificado en
la llamada GetPoint de la línea de comandos. Especifique un punto.
El control vuelve ahora a la macro. La línea que sigue a la llamada al método GetPoint queda resaltada. Continúe la ejecución paso a paso del código
pulsando F8. Recuerde volver a la ventana de AutoCAD cuando tenga que introducir datos.
Ejecución de la macro
No es necesario recorrer paso a paso el código cada vez que se ejecuta la macro. Se puede ejecutar la macro desde el menú Herr. pulsando Macro »
Macros, seleccionando una macro y pulsando Ejecutar. Esto le permite ver el flujo de ejecución de la misma forma en que lo haría el usuario. Ejecute la
macro desde AutoCAD, especificando los siguientes valores:
Punto inicial del camino: 2, 2
Punto final del camino: 9, 8
Mitad de anchura del camino: 2
Radio de las losetas: 0,2
Espacio entre losetas: 0,1
Este ejemplo debería dibujar un camino de jardín como el que se muestra en la siguiente figura:

Adición de interfaz de cuadro de diálogo
La macro Gardenpath se ha escrito para aceptar la introducción de datos en la línea de comando. Para añadir cuadros de diálogo, utilice los formularios
de VBA IDE.

Primero, copie la versión terminada de gardenpath.dvb en otro archivo, gpdialog.dvb. Luego arrastre gpdialog.dvb a AutoCAD.
 Creación del cuadro de diálogo
 Utilización de la ventana Proyecto para navegar por el proyecto
 Actualización del código existente
 Adición de código al cuadro de diálogo
Creacióndel cuadrode diálogo
El cuadro de diálogo que va a crear contiene dos botones de opción (si se selecciona uno, el otro se deselecciona) para escoger la forma de la loseta:
circular o poligonal. El cuadro de diálogo incluye también tres cajas de texto para introducir los siguientes valores numéricos: el radio de las losetas, el
espaciado entre las mismas y el número de lados de la loseta (que está sólo disponible si se ha seleccionado la opción Polígono).
Para crear un cuadro de diálogo en VBA IDE
1. En el menúInsertar,pulse UserFormparaabrir unnuevoformulario.Se muestrandosventanas,uncuadrode herramientasyunformularioenblancode
usuario.
2. Seleccione yarrastre unopor unolossiguientescontrolesdesde el cuadrode herramientasysitúelosenel formulariode usuario.Tendráque colocardos
botonesde opción( ),tresetiquetas( ),trescuadrosde texto( ) ydosbotonesde comando( ),tal como se aprecia enel siguiente
formulario:

3. Cierre el cuadrode herramientas.
Para establecer las propiedades de los controles de botón de opción
1. En el formulariode usuario,seleccioneel control OptionButton1.Enel menúVer,pulse VentanaPropiedadesycambie lassiguientespropiedadespara
OptionButton1:
(Name) = gp_poly
Caption = Polígono
ControlTipText = Loseta en forma de polígono
Accelerator = P
2. En el formulariode usuario,seleccioneel control OptionButton2.Enla ventanaPropiedades,cambielassiguientespropiedadesparaOptionButton2:
(Name) = gp_circ
Caption = Círculo
ControlTipText = Loseta en forma de círculo
Accelerator = I
Para definir las propiedades de los controles de etiqueta

1. En el formulariode usuario,seleccioneel control Label1.EnlaventanaPropiedades,cambie lassiguientespropiedadespara Label1:
(Name) = label_trad
Caption = Radio de las losetas
TabStop = True
2. En el formulariode usuario,seleccioneel control Label2.EnlaventanaPropiedades,cambie lassiguientespropiedadesparaLabel2:
(Name) = label_tspac
Caption = Espacio entre losetas
TabStop = True
3. En el formulariode usuario,seleccioneel control Label3. EnlaventanaPropiedades,cambie lassiguientespropiedadesparaLabel3:
(Name) = label_tsides
Caption = Número de caras
TabStop = True
Para definir las propiedades de los controles del cuadro de texto
1. En el formulariode usuario,seleccioneel control TextBox1.EnlaventanaPropiedades,cambie lassiguientespropiedadesparaTextBox1:
(Name) = gp_trad
(Name) = gp_tspac
(Name) = gp_tsides
Para establecer las propiedades de los controles de botón de comando y la ventana de formulario

1. En el formulariode usuario,seleccioneel control CommandButton1.EnlaventanaPropiedades,cambie lassiguientespropiedadesparaCommandButton1:
(Name) = accept
Caption = Aceptar
ControlTipText = Acepta las opciones
Accelerator = O
Default = True
2. En el formulariode usuario,seleccioneel control CommandButton2.EnlaventanaPropiedades,cambie lassiguientespropiedadesparaCommandButton2:
(Name) = cancel
Caption = Cancelar
ControlTipText = Cancela la operación
Accelerator = C
3. Seleccione todoel formulariohaciendoclicenel fondodel formulario,lejosde cualquiercontrol.EnlaventanaPropiedades,cambielassiguientes
propiedadesparael formulario:
(Name) = gpDialog
Caption = Camino de jardín
El formulario deberá ahora tener este aspecto:
4.

5.
6. Guarde su trabajo.
Utilización de la ventana Proyecto para navegar por el proyecto
En VBA IDE, la ventana Proyecto contiene el nombre y la ubicación del proyecto, una carpeta llamada AutoCAD Objetos y una carpeta llamada
Formularios. (Puede que tenga que pulsar Alternar carpetas para ver las carpetas.) Cuando se abre la carpeta AutoCAD Objetos (puede que ya esté
abierta), puede verse un icono de dibujo y el nombre ThisDrawing. Al abrir la carpeta Formularios (puede que ya esté abierta), puede verse un icono de
formulario y el nombre gpDialog, el formulario que acaba de crear.
Puede utilizar la ventana Proyecto para navegar por el código y para que le ayude a saber dónde está trabajando. Por ejemplo, para ver el código
asociado con el formulario que ha creado, resalte gpDialog en la ventana Proyecto y pulse Ver código.
Se abre la ventana Código correspondiente al formulario.
Resalte ThisDrawing en la ventana Proyecto. Puede ver el código haciendo clic en Ver código. Todo el código que ha escrito está en esta ventana.
Actualizacióndel códigoexistente
Ahora que ha creado un cuadro de diálogo, puede añadir o modificar código.

Para modificar el código existente
1. Abra el códigocorrespondiente aThisDrawing,si todavíanoestáabierto.
2. Actualice lassiguienteslíneasde lasecciónDeclaraciones:
Public trad As Double ' Actualizado
Public tspac As Double ' Actualizado
Public tsides As Integer ' Adición
Public tshape As String ' Adición
Puesto que el código del formulario accede a trad y tspac, ha actualizado sus definiciones para hacerlas públicas. Las variables privadas sólo
están disponibles en el módulo en el que se han definido, por lo que las variables deben convertirse en públicas. Además, ha añadido tsides para
el número de lados de las losetas poligonales y tshape para que el usuario seleccione la forma de las losetas, que puede ser un círculo o un
polígono.
3. Vayaa lasubrutinagpuser.Elimine lasdoslíneasque obtienenel radiode laslosetasyel espacioentre ellas,puestoque estainformaciónse obtiene ahora
a travésdel formulario.Enconcreto, elimine losiguiente:
trad = ThisDrawing.Utility. _
GetDistance(sp, "Radio de las losetas: ")
tspac = ThisDrawing.Utility. _
GetDistance(sp, "Espacio entre losetas: ")
4. Añadalas líneasque cargan y muestranel formulario.Añadalassiguienteslíneasenel lugarde laslíneas eliminadasenel paso3:
Load gpDialog
gpDialog.Show
5. Añadauna subrutinaal final del archivode códigoque dibujatantolaslosetascircularescomolaslosetaspoligonales:
'Dibuja la loseta con la forma seleccionada
Sub DrawShape(pltile)
Dim angleSegment As Double
Dim currentAngle As Double
Dim angleInRadians As Double
Dim currentSide As Integer
Dim aCircle As AcadCircle
Dim aPolygon As AcadLWPolyline
ReDim points(1 To tsides * 2) As Double
'Rama basada en el tipo de forma a dibujar
Select Case tshape
Case "Círculo"
Set aCircle = ThisDrawing.ModelSpace. _

AddCircle(pltile, trad)
Case "Polígono"
angleSegment = 360 / tsides
currentAngle = 0
For currentSide = 0 To (tsides - 1)
angleInRadians = dtr(currentAngle)
varRet = ThisDrawing.Utility.PolarPoint(pltile, _
angleInRadians, trad)
points((currentSide * 2) + 1) = varRet(0)
points((currentSide * 2) + 2) = varRet(1)
currentAngle = currentAngle + angleSegment
Next currentSide
Set aPolygon = ThisDrawing.ModelSpace. _
aPolygon.Closed = True
End Select
End Sub
Esta subrutina utiliza la instrucción Select Case para ramificar el control del programa según el tipo de forma que se deba dibujar. La variable
tshape se utiliza para determinar el tipo de forma.
6. A continuación,vayaala subrutinadrow.Encuentre losdoscasosen losque aparece lasiguiente línea:
Set cir = ThisDrawing.ModelSpace.AddCircle(pltile, trad)
Cambie estas líneas para que dibujen la forma correspondiente de losetas, como se muestra a continuación:
DrawShape (pltile) ' Actualizado
Adiciónde códigoal cuadro de diálogo
Ahora puede eliminar el código para la creación de losetas circulares e invocar la subrutina DrawShape para que dibuje la forma apropiada.
Para añadir gestores de eventos para el cuadro de diálogo
1. Abrirel códigopara gpDialog.
2. Escriba el siguientecódigoenlaparte superiorde laventana:
Private Sub gp_poly_Click()
gp_tsides.Enabled = True

ThisDrawing.tshape = "Polígono"
End Sub
Private Sub gp_circ_Click()
gp_tsides.Enabled = False
ThisDrawing.tshape = "Círculo"
End Sub
Observe que las subrutinas gp_poly_Click() y gp_circ_Click() tienen el mismo nombre que los dos controles de opción añadidos anteriormente,
con la adición de _Click. Estas subrutinas se ejecutan automáticamente cuando el usuario pulsa en el control respectivo. Observe también que el
cuadro Objeto muestra los controles del formulario, ordenados alfabéticamente por la propiedad "Name" (nombre).
1. Sitúe el cursor sobre la línea Private Sub gp_poly_Click() y abra el cuadro Procedimiento/Evento.
Podrá ver una lista de todos los eventos a los que puede responder para el control de opción gp_poly. Las dos subrutinas que ha escrito gestionan
el evento Click. También puede añadir código para responder al evento DblClick, que se ejecutará automáticamente cuando el usuario haga
doble clic en el control. Puede añadir código para cualquiera de los eventos de la lista. Estos tipos de subrutinas se denominan gestores de
eventos.
Observe el código que ha escrito para estos dos gestores de eventos. El primer gestor de eventos responde al evento Click que corresponde al
control de opción gp_poly. La primera línea de código activa el cuadro de texto para el número de lados. Este cuadro de texto sólo está
disponible para polígonos, por lo que no está activado a no ser que seleccione el control Polígono. La siguiente línea de código establece la
variable tshape como Polígono.
El segundo gestor de eventos responde al evento Click para el control de opción gp_circ . Este gestor desactiva el cuadro de texto para número de
lados y establece la variable tshape en Círculo.
2. Añada el siguiente gestor de eventos para el botón Aceptar:

Private Sub accept_Click()
If ThisDrawing.tshape = "Polígono" Then
ThisDrawing.tsides = CInt(gp_tsides.text)
If (ThisDrawing.tsides < 3#) Or _
(ThisDrawing.tsides > 1024#) Then
MsgBox "Escriba un valor entre 3 y " & _
"1024 para el número de lados."
Exit Sub
End If
End If
ThisDrawing.trad = CDbl(gp_trad.text)
ThisDrawing.tspac = CDbl(gp_tspac.text)
If ThisDrawing.trad < 0# Then
MsgBox "Escriba un valor positivo para el radio."
Exit Sub
End If
If (ThisDrawing.tspac < 0#) Then
MsgBox "Escriba un valor positivo para el espaciado."
Exit Sub
End If
GPDialog.Hide
End Sub
Este código comprueba si la elección final de la forma ha sido la de polígono. Si es así, el código obtiene el número de lados del control
gp_tsides. El valor que introduce el usuario se almacena en la propiedad Text. Puesto que se almacena como cadena de texto, la cadena debe
convertirse al entero equivalente utilizando la función CInt. Una vez obtenido, el gestor de eventos comprueba el rango del valor para asegurar
que se encuentra entre 3 y 1024. Si no es así, se muestra un mensaje y se sale del gestor de eventos sin que tenga lugar ningún otro proceso. El
resultado es que aparece un mensaje y que el usuario tiene otra oportunidad para cambiar el valor. Después de pulsar de nuevo el botón Aceptar,
este gestor de eventos se ejecuta y vuelve a comprobar el valor.
La macro obtiene valores de radio y de espacio, pero estos valores son dobles, no enteros, y se obtienen utilizando la función CDbl. Estos valores
también se verifican para comprobar que son positivos.
Una vez obtenidos y verificados los valores, la instrucción gpDialog.Hide oculta el formulario, devolviendo el control a la subrutina que invocó
el formulario por primera vez.
3. Añada el siguiente gestor de eventos para el botón Cancelar:
Private Sub cancel_Click()
Unload Me
Final
End Sub
Este sencillo gestor de eventos descarga el formulario y completa la macro.

Lo único que todavía no ha hecho es añadir los valores iniciales para el formulario. Hay un evento llamado Initialize que se aplica al formulario.
Se ejecuta cuando se carga el formulario por primera vez.
4. Añada el siguiente gestor de eventos para la inicialización de formularios:
Private Sub UserForm_Initialize()
gp_circ.Value = True
gp_trad.Text = ".2"
gp_tspac.Text = ".1"
gp_tsides.Text = "5"
gp_tsides.Enabled = False
ThisDrawing.tsides = 5
End Sub
Este código establece los valores iniciales del formulario y para la variable tsides. La tsides debe establecerse en un número positivo mayor que 3,
aunque el usuario seleccione un círculo. Para comprender esto, fíjese en la subrutina DrawShape que ha escrito anteriormente. Hay una variable llamada
points que se define utilizando el número de lados del polígono. Tanto si se solicita una forma de polígono como si no, se asigna memoria a la variable.
Por este motivo, tsides debe estar dentro de un rango válido. El usuario puede cambiar este valor durante la ejecución de la macro.
Ahora puede guardar la macro y ejecutarla desde AutoCAD.
EJEMPLOS DE CODIGOVBA Y ACTIVEX
Action Example
Sub Example_Action()
' This example encrypts and saves a file.
Dim acad As New AcadApplication
Dim sp As New AcadSecurityParams
acad.Visible = True
sp.Action = AcadSecurityParamsType.ACADSECURITYPARAMS_ENCRYPT_DATA
sp.Algorithm = AcadSecurityParamsConstants.ACADSECURITYPARAMS_ALGID_RC4
sp.KeyLength = 40
sp.Password = UCase("mypassword") 'AutoCAD converts all passwords to uppercase before applying them
sp.ProviderName = "Microsoft Base Cryptographic Provider v1.0"
sp.ProviderType = 1
acad.ActiveDocument.SaveAs "C:MyDrawing.dwg", , sp

End Sub
Activate Event Example
Private Sub AcadDocument_Activate()
' This example intercepts a drawing Activate event.
'
' This event is triggered when a drawing window becomes active.
'
' To trigger this example event: Either open a new drawing or switch from
' one drawing window to another
MsgBox "You have just activated a drawing!"
End Sub
Activate Example
Sub Example_ActivateMethod()
' This example creates two new drawings and activates each drawing in turn.
Dim NewDrawing1 As AcadDocument
Dim Newdrawing2 As AcadDocument
Set NewDrawing1 = ThisDrawing.Application.Documents.Add("")
Set Newdrawing2 = ThisDrawing.Application.Documents.Add("")
Dim drawing As AcadDocument
For Each drawing In ThisDrawing.Application.Documents
drawing.Activate
MsgBox "Drawing " & drawing.name & " is active."
Next drawing
End Sub
Active Example
Sub Example_Active()
' This example creates two new drawings and determines
' which of the drawings is the active drawing.
Dim NewDrawing1 As AcadDocument
Dim Newdrawing2 As AcadDocument

Set NewDrawing1 = ThisDrawing.Application.Documents.Add("")
Set Newdrawing2 = ThisDrawing.Application.Documents.Add("")
Dim activeStatus As String
Dim drawing As AcadDocument
activeStatus = ""
For Each drawing In ThisDrawing.Application.Documents
If drawing.Active Then
activeStatus = activeStatus & drawing.name & " is active." & vbCrLf
Else
activeStatus = activeStatus & drawing.name & " is not active." & vbCrLf
End If
Next drawing
MsgBox activeStatus
End Sub
ActiveDimStyle Example
Sub Example_ActiveDimStyle()
' This example returns the current dimension style
' and then sets a new style.
' Finally, it returns the style to the previous setting.
Dim newDimStyle As AcadDimStyle
Dim currDimStyle As AcadDimStyle
' Return current dimension style of active document
Set currDimStyle = ThisDrawing.ActiveDimStyle
MsgBox "The current dimension style is " & currDimStyle.name, vbInformation, "ActiveDimStyle Example"
' Create a dimension style and makes it current
Set newDimStyle = ThisDrawing.DimStyles.Add("TestDimStyle")
ThisDrawing.ActiveDimStyle = newDimStyle ' set current dimension style to newDimStyle
MsgBox "The new dimension style is " & newDimStyle.name, vbInformation, "ActiveDimStyle Example"
' Reset the dimension style to its previous setting
ThisDrawing.ActiveDimStyle = currDimStyle
MsgBox "The dimension style is reset to " & currDimStyle.name, vbInformation, "ActiveDimStyle Example"
End Sub
ActiveDocument Example
Sub Example_ActiveDocument()
Dim activeDoc As AcadDocument
' Returns current document in AutoCAD
Set activeDoc = ThisDrawing.Application.ActiveDocument

MsgBox "The active document is: " & activeDoc.name, vbInformation, "ActiveDocument Example"
End Sub
ActiveLayer Example
Sub Example_ActiveLayer()
' This example returns the current layer
' and then adds a new layer.
' Finally, it returns the layer to the previous setting.
Dim currLayer As AcadLayer
Dim newLayer As AcadLayer
' Return the current layer of the active document
Set currLayer = ThisDrawing.ActiveLayer
MsgBox "The current layer is " & currLayer.name, vbInformation, "ActiveLayer Example"
' Create a Layer and make it the active layer
Set newLayer = ThisDrawing.Layers.Add("TestLayer")
ThisDrawing.ActiveLayer = newLayer
MsgBox "The new layer is " & newLayer.name, vbInformation, "ActiveLayer Example"
' Reset the layer to its previous setting
ThisDrawing.ActiveLayer = currLayer
MsgBox "The active layer is reset to " & currLayer.name, vbInformation, "ActiveLayer Example"
End Sub
ActiveLayout Example
Sub Example_ActiveLayout()
' This example cycles through the documents collection
' and uses the ActiveLayout object to list the active layout
' for all open documents.
Dim DOC As AcadDocument
Dim msg As String
' If there are no open documents, then exit
If Documents.count = 0 Then
MsgBox "There are no open documents!"
Exit Sub
End If
msg = vbCrLf & vbCrLf ' Start with a space

' Cycle through documents and determine the active layout name using the
' ActiveLayout property of the document object
For Each DOC In Documents
msg = msg & DOC.WindowTitle & ": " & DOC.ActiveLayout.name
Next
' Display results
MsgBox "The active layouts for the open drawings are: " & msg
End Sub
ActiveLinetype Example
Sub Example_ActiveLinetype()
' This example finds the current linetype. It then sets
' the new linetype to be the first entry in the linetype
' collection that is not equal to the current linetype.
' Finally, it resets the active linetype to the original
' setting.
Dim currLineType As AcadLineType
Dim newLineType As AcadLineType
' Find the current LineType of the active document
Set currLineType = ThisDrawing.ActiveLinetype
MsgBox "The current linetype is " & currLineType.name, vbInformation, "ActiveLinetype Example"
' Set the current Linetype to anything else in the collection
Dim entry
Dim found As Boolean
For Each entry In ThisDrawing.Linetypes
If StrComp(entry.name, currLineType.name, 1) <> 0 Then
Set newLineType = entry
found = True
Exit For
End If
Next
If found Then
ThisDrawing.ActiveLinetype = newLineType
MsgBox "The new linetype is " & newLineType.name, vbInformation, "ActiveLinetype Example"
' Reset the linetype to the previous setting
ThisDrawing.ActiveLinetype = currLineType
MsgBox "The active linetype is reset to " & currLineType.name, vbInformation, "ActiveLinetype Example"
End If
End Sub

ActiveProfile Example
Sub Example_ActiveProfile()
' This example returns the current setting of
' ActiveProfile.
Dim preferences As AcadPreferences
Dim currActiveProfile As String
Set preferences = ThisDrawing.Application.preferences
' Retrieve the current ActiveProfile value
currActiveProfile = preferences.Profiles.ActiveProfile
MsgBox "The current value for ActiveProfile is " & currActiveProfile, vbInformation, "ActiveProfile Example"
End Sub
ActivePViewport Example
Sub Example_ActivePViewport()
Dim newPViewport As AcadPViewport
Dim centerPoint(0 To 2) As Double
Dim width As Double
height = 5#
width = 5#
centerPoint(0) = 5#: centerPoint(1) = 5#: centerPoint(2) = 0#
' Create a paper space Viewport object
ThisDrawing.ActiveSpace = acPaperSpace
Set newPViewport = ThisDrawing.PaperSpace.AddPViewport(centerPoint, width, height)
ZoomAll
newPViewport.DISPLAY (True)
' Before making a paper space Viewport active,
' the mspace property needs to be True
ThisDrawing.mspace = True
ThisDrawing.ActivePViewport = newPViewport
End Sub

ActiveSelectionSet Example
Sub Example_ActiveSelectionSet()
Dim sset As AcadSelectionSet
' The following example returns current selection set from current drawing
Set sset = ThisDrawing.ActiveSelectionSet
End Sub
ActiveSpace Example
Sub Example_ActiveSpace()
' This example toggles the ActiveSpace property from
' paper space to model space.
' Display the current setting for TILEMODE
MsgBox "TILEMODE = " & ThisDrawing.ActiveSpace, vbInformation, "ActiveSpace Example"
' Changes active document to paper space
' Changes active document to model space
ThisDrawing.ActiveSpace = acModelSpace
End Sub
ActiveTextStyle Example
Sub Example_ActiveTextStyle()
' This example returns the current text style
' and then sets a new style.
' Finally, it returns the style to the previous setting.
Dim newTextStyle As AcadTextStyle
Dim currTextStyle As AcadTextStyle
' Return current text style of active document
Set currTextStyle = ThisDrawing.ActiveTextStyle
MsgBox "The current text style is " & currTextStyle.name, vbInformation, "ActiveTextStyle Example"
' Create a text style and make it current
Set newTextStyle = ThisDrawing.TextStyles.Add("TestTextStyle")
ThisDrawing.ActiveTextStyle = newTextStyle
MsgBox "The new text style is " & newTextStyle.name, vbInformation, "ActiveTextStyle Example"

' Reset the text style to its previous setting
ThisDrawing.ActiveTextStyle = currTextStyle
MsgBox "The text style is reset to " & currTextStyle.name, vbInformation, "ActiveTextStyle Example"
End Sub
ActiveUCS Example
Sub Example_ActiveUCS()
' This example returns the current saved UCS (or saves a new one dynamically)
' and then sets a new UCS.
' Finally, it returns the UCS to the previous setting.
Dim newUCS As AcadUCS
Dim currUCS As AcadUCS
Dim xAxis(0 To 2) As Double
Dim yAxis(0 To 2) As Double
' Get the current saved UCS of the active document. If the current UCS is
' not saved, then add a new UCS to the UserCoordinateSystems collection
If ThisDrawing.GetVariable("UCSNAME") = "" Then
' Current UCS is not saved so get the data and save it
With ThisDrawing
Set currUCS = .UserCoordinateSystems.Add( _
.GetVariable("UCSORG"), _
.Utility.TranslateCoordinates(.GetVariable("UCSXDIR"), acUCS, acWorld, 0), _
.Utility.TranslateCoordinates(.GetVariable("UCSYDIR"), acUCS, acWorld, 0), _
"OriginalUCS")
End With
Else
Set currUCS = ThisDrawing.ActiveUCS 'current UCS is saved
End If
MsgBox "The current UCS is " & currUCS.name, vbInformation, "ActiveUCS Example"
' Create a UCS and make it current
origin(0) = 0: origin(1) = 0: origin(2) = 0
xAxis(0) = 1: xAxis(1) = 1: xAxis(2) = 0
yAxis(0) = -1: yAxis(1) = 1: yAxis(2) = 0
Set newUCS = ThisDrawing.UserCoordinateSystems.Add(origin, xAxis, yAxis, "TestUCS")
ThisDrawing.ActiveUCS = newUCS
MsgBox "The new UCS is " & newUCS.name, vbInformation, "ActiveUCS Example"
' Reset the UCS to its previous setting
ThisDrawing.ActiveUCS = currUCS
MsgBox "The UCS is reset to " & currUCS.name, vbInformation, "ActiveUCS Example"

End Sub
ActiveViewport Example
Sub Example_ActiveViewport()
' This example returns the current viewport.
' It creates a new viewport and makes it active, and
' Then it splits the viewport into four windows.
' It then takes one of the four windows, and splits that
' window horizontally into half.
Dim currViewport As AcadViewport
Dim newViewport As AcadViewport
' Returns current viewport of active document
Set currViewport = ThisDrawing.ActiveViewport
MsgBox "The current viewport is " & currViewport.name, vbInformation, "ActiveViewport Example"
' Create a new viewport and make it active
Set newViewport = ThisDrawing.Viewports.Add("TESTVIEWPORT")
ThisDrawing.ActiveViewport = newViewport
MsgBox "The new active viewport is " & newViewport.name, vbInformation, "ActiveViewport Example"
' Split the viewport in four windows
newViewport.Split acViewport4
' Make the newly split viewport active
' Note that current drawing layout will show four windows.
' However, only one of the windows will be active.
' The following code sets the lower-left corner window
' to be the active window and then splits that
' window into two horizontal windows.
Dim entry
For Each entry In ThisDrawing.Viewports
If entry.name = "TESTVIEWPORT" Then
Dim lowerLeft
lowerLeft = entry.LowerLeftCorner
If lowerLeft(0) = 0 And lowerLeft(1) = 0 Then
Set newViewport = entry
Exit For
End If
End If
Next
newViewport.Split acViewport2Horizontal
End Sub

Add Example
Sub Example_Add()
' This example adds a block, dictionary, dimension style,
' group, layer, registered application, selection set,
' textstyle, view, viewport and UCS using the Add method.
GoSub ADDBLOCK
GoSub ADDDICTIONARY
GoSub ADDDIMSTYLE
GoSub ADDGROUP
GoSub ADDLAYER
GoSub ADDREGISTEREDAPP
GoSub ADDSELECTIONSET
GoSub ADDTEXTSTYLE
GoSub ADDVIEW
GoSub ADDVIEWPORT
GoSub ADDUCS
GoSub ADDMATERIAL
Exit Sub
ADDBLOCK:
' Create a new block called "New_Block"
Dim blockObj As AcadBlock
' Define the block
Dim insertionPnt(0 To 2) As Double
insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
' Add the block to the blocks collection
Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "New_Block")
MsgBox blockObj.name & " has been added." & vbCrLf & _
"Origin: " & blockObj.origin(0) & ", " & blockObj.origin(1) _
& ", " & blockObj.origin(2), , "Add Example"
Return
ADDDICTIONARY:
' Create a new dictionary called "New_Dictionary"
Dim dictObj As AcadDictionary
' Add the dictionary to the dictionaries collection
Set dictObj = ThisDrawing.Dictionaries.Add("New_Dictionary")
MsgBox dictObj.name & " has been added.", , "Add Example"

Return
ADDDIMSTYLE:
' Create a new dimension style called "New_Dimstyle" in current drawing
Dim DimStyleObj As AcadDimStyle
' Add the dimstyle to the dimstyles collection
Set DimStyleObj = ThisDrawing.DimStyles.Add("New_Dimstyle")
MsgBox DimStyleObj.name & " has been added.", , "Add Example"
Return
ADDGROUP:
' Create a new group called "New_Group" in current drawing
Dim groupObj As AcadGroup
' Add the group to the groups collection
Set groupObj = ThisDrawing.Groups.Add("New_Group")
MsgBox groupObj.name & " has been added.", , "Add Example"
Return
ADDLAYER:
' This example creates a new layer called "New_Layer"
Dim layerObj As AcadLayer
' Add the layer to the layers collection
Set layerObj = ThisDrawing.Layers.Add("New_Layer")
' Make the new layer the active layer for the drawing
ThisDrawing.ActiveLayer = layerObj
' Display the status of the new layer
MsgBox layerObj.name & " has been added." & vbCrLf & _
"LayerOn Status: " & layerObj.LayerOn & vbCrLf & _
"Freeze Status: " & layerObj.Freeze & vbCrLf & _
"Lock Status: " & layerObj.Lock & vbCrLf & _
"Color: " & layerObj.Color, , "Add Example"
Return
ADDREGISTEREDAPP:
' Create a registered application named "New_RegApp" in current drawing
Dim RegAppObj As AcadRegisteredApplication
' Add the registered application to the registered applications collection
Set RegAppObj = ThisDrawing.RegisteredApplications.Add("New_RegApp")
MsgBox RegAppObj.name & " has been added.", , "Add Example"
Return
ADDSELECTIONSET:
' Create a selectionset named "New_SelectionSet" in current drawing

Dim ssetObj As AcadSelectionSet
' Add the selection set to the selection sets collection
Set ssetObj = ThisDrawing.SelectionSets.Add("New_SelectionSet")
MsgBox ssetObj.name & " has been added." & vbCrLf & _
"The number of items in the selection set is " & ssetObj.count _
, , "Add Example"
Return
ADDTEXTSTYLE:
' Create a textstyle named "New_Textstyle" in current drawing
Dim txtStyleObj As AcadTextStyle
' Add the textstyle to the textstyles collection
Set txtStyleObj = ThisDrawing.TextStyles.Add("New_Textstyle")
MsgBox txtStyleObj.name & " has been added." & vbCrLf & _
"Height: " & txtStyleObj.height & vbCrLf & _
"Width: " & txtStyleObj.width, , "Add Example"
Return
ADDVIEW:
' Create a view named "New_View" in current drawing
Dim viewObj As AcadView
' Add the view to the views collection
Set viewObj = ThisDrawing.Views.Add("New_View")
MsgBox viewObj.name & " has been added." & vbCrLf & _
"Height: " & viewObj.height & vbCrLf & _
"Width: " & viewObj.width, , "Add Example"
Return
ADDVIEWPORT:
' Create a viewport named "New_Viewport" in current drawing
Dim vportObj As AcadViewport
' Add the viewport to the viewports collection
Set vportObj = ThisDrawing.Viewports.Add("New_Viewport")
MsgBox vportObj.name & " has been added." & vbCrLf & _
"GridOn Status: " & vportObj.GridOn & vbCrLf & _
"OrthoOn Status: " & vportObj.OrthoOn & vbCrLf & _
"SnapOn Status: " & vportObj.SnapOn, , "Add Example"
Return
ADDUCS:
' Create a UCS named "New_UCS" in current drawing
Dim ucsObj As AcadUCS
Dim xAxisPnt(0 To 2) As Double
Dim yAxisPnt(0 To 2) As Double

' Define the UCS
origin(0) = 4#: origin(1) = 5#: origin(2) = 3#
xAxisPnt(0) = 5#: xAxisPnt(1) = 5#: xAxisPnt(2) = 3#
yAxisPnt(0) = 4#: yAxisPnt(1) = 6#: yAxisPnt(2) = 3#
' Add the UCS to the UserCoordinatesSystems collection
Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPnt, yAxisPnt, "New_UCS")
MsgBox ucsObj.name & " has been added." & vbCrLf & _
"Origin: " & ucsObj.origin(0) & ", " & ucsObj.origin(1) _
& ", " & ucsObj.origin(2), , "Add Example"
Return
ADDMATERIAL:
Dim oMaterial As AcadMaterial
Dim oMaterials As AcadMaterials
Set oMaterial = ThisDrawing.Materials.Add("TestMaterial")
oMaterial.Description = "This example demonstrates how to add a material to a database."
ThisDrawing.ActiveMaterial = oMaterial
' Display the status of the new layer
MsgBox oMaterial.Name & " has been added." & vbCrLf & _
"Name: " & oMaterial.Name & vbCrLf & vbCrLf & _
"Description: " & vbCrLf & vbCrLf & _
oMaterial.Description
Return
End Sub
Add3DFace Example
Sub Example_Add3DFace()
' This example creates a 3D face in model space.
Dim faceObj As Acad3DFace
' Define the four coordinates of the face
' Create the 3DFace object in model space
Set faceObj = ThisDrawing.ModelSpace.Add3DFace(point1, point2, point3, point4)

ZoomAll
End Sub
Add3DMesh Example
Sub Example_Add3DMesh()
' This example creates a 4 X 4 polygonmesh in model space.
Dim meshObj As AcadPolygonMesh
Dim mSize, nSize, count As Integer
' Create the matrix of points
mSize = 4: nSize = 4
' creates a 3Dmesh in model space
Set meshObj = ThisDrawing.ModelSpace.Add3DMesh(mSize, nSize, points)
' Change the viewing direction of the viewport to better see the polygonmesh
NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
ZoomAll
End Sub

Add3DPoly Example
Sub Example_Add3DPoly()
Dim polyObj As Acad3DPolyline
' Create the array of points
' Create a 3DPolyline in model space
Set polyObj = ThisDrawing.ModelSpace.Add3DPoly(points)
ZoomAll
End Sub
AddArc Example
Sub Example_AddArc()
' This example creates an arc in model space.
Dim arcObj As AcadArc
Dim startAngleInDegree As Double
Dim endAngleInDegree As Double
' Define the circle
radius = 5#
startAngleInDegree = 10#
endAngleInDegree = 230#
' Convert the angles in degrees to angles in radians
Dim startAngleInRadian As Double
Dim endAngleInRadian As Double
startAngleInRadian = startAngleInDegree * 3.141592 / 180#
endAngleInRadian = endAngleInDegree * 3.141592 / 180#
' Create the arc object in model space
Set arcObj = ThisDrawing.ModelSpace.AddArc(centerPoint, radius, startAngleInRadian, endAngleInRadian)
ZoomAll

End Sub
AddAttribute Example
Sub Example_AddAttribute()
' This example creates an attribute definition in model space.
Dim attributeObj As AcadAttribute
Dim mode As Long
Dim prompt As String
Dim insertionPoint(0 To 2) As Double
Dim tag As String
Dim value As String
' Define the attribute definition
height = 1#
mode = acAttributeModeVerify
prompt = "New Prompt"
insertionPoint(0) = 5#: insertionPoint(1) = 5#: insertionPoint(2) = 0
tag = "NEW_TAG"
value = "New Value"
' Create the attribute definition object in model space
Set attributeObj = ThisDrawing.ModelSpace.AddAttribute(height, mode, prompt, insertionPoint, tag, value)
ZoomAll
End Sub
AddBox Example
Sub Example_AddBox()
' This example creates a box in model space.
Dim length As Double, width As Double, height As Double
' Define the box
Set boxObj = ThisDrawing.ModelSpace.AddBox(center, length, width, height)

' Change the viewing direction of the viewport to better see the box
ZoomAll
End Sub
AddCircle Example
Sub Example_AddCircle()
' This example creates a circle in model space.
Dim circleObj As AcadCircle
' Define the circle
radius = 5#
' Create the Circle object in model space
Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPoint, radius)
ZoomAll
End Sub
AddCone Example
Sub Example_AddCone()
' This example creates a cone in model space.
Dim coneObj As Acad3DSolid
' Define the cone
center(0) = 0#: center(1) = 0#: center(2) = 0#
radius = 5#
height = 20#
' Create the Cone (3DSolid) object in model space
Set coneObj = ThisDrawing.ModelSpace.AddCone(center, radius, height)

' Change the viewing direction of the viewport to better see the cone
ZoomAll
End Sub
AddCylinder Example
Sub AddCylinder()
' This example creates a cylinder in model space.
' Define the cylinder
radius = 5#
height = 20#
' Create the Cylinder (3DSolid) object in model space
Set cylinderObj = ThisDrawing.ModelSpace.AddCylinder(center, radius, height)
' Change the viewing direction of the viewport to better see the cylinder
ZoomAll
End Sub
AddDim3PointAngular Example
Sub Example_AddDim3PointAngular()
' This example creates a Dim3PointAngular object in model space
Dim DimPointAngularObj As AcadDim3PointAngular
Dim AngleVertex(0 To 2) As Double
Dim FirstPoint(0 To 2) As Double, SecondPoint(0 To 2) As Double
Dim TextPoint(0 To 2) As Double

' Define the new Dim3PointAngular object
AngleVertex(0) = 0: AngleVertex(1) = 0: AngleVertex(2) = 0
FirstPoint(0) = 2: FirstPoint(1) = 2: FirstPoint(2) = 0
SecondPoint(0) = 2: SecondPoint(1) = 4: SecondPoint(2) = 0
TextPoint(0) = 6: TextPoint(1) = 6: TextPoint(2) = 0
' Create the new Dim3PointAngular object in model space
Set DimPointAngularObj = ThisDrawing.ModelSpace.AddDim3PointAngular(AngleVertex, FirstPoint, SecondPoint, TextPoint)
MsgBox "A Dim3PointAngular object has been created."
End Sub
AddDimAligned Example
Sub Example_AddDimAligned()
' This example creates an aligned dimension in model space.
Dim dimObj As AcadDimAligned
' Define the dimension
' Create an aligned dimension object in model space
Set dimObj = ThisDrawing.ModelSpace.AddDimAligned(point1, point2, location)
ZoomAll
End Sub
AddDimAngular Example
Sub Example_AddDimAngular()
' This example creates an angular dimension in model space.
Dim dimObj As AcadDimAngular
Dim angVert(0 To 2) As Double
Dim FirstPoint(0 To 2) As Double
Dim SecondPoint(0 To 2) As Double

angVert(0) = 0#: angVert(1) = 5#: angVert(2) = 0#
FirstPoint(0) = 1#: FirstPoint(1) = 7#: FirstPoint(2) = 0#
SecondPoint(0) = 1#: SecondPoint(1) = 3#: SecondPoint(2) = 0#
TextPoint(0) = 3#: TextPoint(1) = 5#: TextPoint(2) = 0#
' Create the angular dimension in model space
Set dimObj = ThisDrawing.ModelSpace.AddDimAngular(angVert, FirstPoint, SecondPoint, TextPoint)
ZoomAll
End Sub
AddDimArc Example
Sub Example_AddDimArc()
Dim PI As Double: PI = 3.141592
Dim oMS As IAcadModelSpace3
Set oMS = ThisDrawing.ModelSpace
Dim ptCenter(2) As Double
Dim oA As AcadArc
Set oA = oMS.AddArc(ptCenter, 10, PI / 3, PI * 3 / 4)
Dim ptArcPoint(2) As Double
ptArcPoint(0) = 0: ptArcPoint(1) = 15
Dim oAcadDimArcLength As AcadDimArcLength
Set oAcadDimArcLength = oMS.AddDimArc(oA.Center, oA.startPoint, oA.endPoint, ptArcPoint)
Update
ZoomExtents
End Sub
AddDimDiametric Example
Sub Example_AddDimDiametric()
' This example creates a diametric dimension in model space.
Dim dimObj As AcadDimDiametric
Dim chordPoint(0 To 2) As Double
Dim farChordPoint(0 To 2) As Double
Dim leaderLength As Double
chordPoint(0) = 5#: chordPoint(1) = 3#: chordPoint(2) = 0#

farChordPoint(0) = 5#: farChordPoint(1) = 5#: farChordPoint(2) = 0#
leaderLength = 1#
' Create the diametric dimension in model space
Set dimObj = ThisDrawing.ModelSpace.AddDimDiametric(chordPoint, farChordPoint, leaderLength)
ZoomAll
End Sub
AddDimOrdinate Example
Sub Example_AddDimOrdinate()
' This example creates an ordinate dimension in model space.
Dim dimObj As AcadDimOrdinate
Dim definingPoint(0 To 2) As Double
Dim leaderEndPoint(0 To 2) As Double
Dim useXAxis As Long
definingPoint(0) = 5#: definingPoint(1) = 5#: definingPoint(2) = 0#
leaderEndPoint(0) = 10#: leaderEndPoint(1) = 5#: leaderEndPoint(2) = 0#
useXAxis = 5#
' Create an ordinate dimension in model space
Set dimObj = ThisDrawing.ModelSpace.AddDimOrdinate(definingPoint, leaderEndPoint, useXAxis)
ZoomAll
End Sub
AddDimRadial Example
Sub Example_AddDimRadial()
' This example creates a radial dimension in model space.
Dim dimObj As AcadDimRadial
Dim chordPoint(0 To 2) As Double
Dim leaderLen As Integer
chordPoint(0) = 5#: chordPoint(1) = 5#: chordPoint(2) = 0#
leaderLen = 5

' Create the radial dimension in model space
Set dimObj = ThisDrawing.ModelSpace.AddDimRadial(center, chordPoint, leaderLen)
ZoomAll
End Sub
AddDimRadialLarge Example
Sub Example_AddDimRadialLarge()
Dim PI As Double: PI = 3.141592
Dim oMS As IAcadModelSpace3
Set oMS = ThisDrawing.ModelSpace
Dim ptCenter(2) As Double
Dim oA As AcadArc
Set oA = oMS.AddArc(ptCenter, 10, PI / 3, PI * 3 / 4)
Dim ptChordPoint(2) As Double
ptChordPoint(0) = 0: ptChordPoint(1) = 10: ptChordPoint(2) = 0
Dim ptOverrideCenter(2) As Double
ptOverrideCenter(0) = -3: ptOverrideCenter(1) = -6: ptOverrideCenter(2) = 0
Dim ptJogPoint(2) As Double
ptJogPoint(0) = 0: ptJogPoint(1) = 5: ptJogPoint(2) = 0
Dim oDimRadialLarge As AcadDimRadialLarge
Set oDimRadialLarge = oMS.AddDimRadialLarge(oA.Center, ptChordPoint, ptOverrideCenter, ptJogPoint, PI / 4)
Dim ptTextPosition(2) As Double
ptTextPosition(0) = 0: ptTextPosition(1) = 6: ptTextPosition(2) = 0
oDimRadialLarge.TextPosition = ptTextPosition
Update
ZoomExtents
End Sub
AddDimRotated Example
Sub Example_AddDimRotated()
' This example creates a rotated dimension in model space.
Dim dimObj As AcadDimRotated

Dim rotAngle As Double
rotAngle = 120
rotAngle = rotAngle * 3.141592 / 180# ' covert to Radians
' Create the rotated dimension in model space
Set dimObj = ThisDrawing.ModelSpace.AddDimRotated(point1, point2, location, rotAngle)
ZoomAll
End Sub
AddEllipse Example
Sub Example_AddEllipse()
' This example creates an ellipse in model space.
Dim ellObj As AcadEllipse
Dim majAxis(0 To 2) As Double
Dim radRatio As Double
' Create an ellipse in model space
majAxis(0) = 10: majAxis(1) = 20#: majAxis(2) = 0#
radRatio = 0.3
Set ellObj = ThisDrawing.ModelSpace.AddEllipse(center, majAxis, radRatio)
ZoomAll
End Sub
AddEllipticalCone Example
Sub Example_AddEllipticalCone()
' This example creates an elliptical cone in model space.
Dim coneObj As Acad3DSolid
Dim majorRadius As Double
Dim minorRadius As Double

' Define the elliptical cone
majorRadius = 10#
minorRadius = 5#
height = 20#
' Create the elliptical cone in model space
Set coneObj = ThisDrawing.ModelSpace.AddEllipticalCone(center, majorRadius, minorRadius, height)
' Change the viewing direction of the viewport to better see the cone
ZoomAll
End Sub
AddEllipticalCylinder Example
Sub Example_AddEllipticalCylinder()
' This example creates an elliptical cylinder in model space.
Dim majorRadius As Double
Dim minorRadius As Double
' Define the elliptical cylinder
majorRadius = 5#
minorRadius = 2.5
height = 10#
' Create the elliptical cylinder in model space
Set cylinderObj = ThisDrawing.ModelSpace.AddEllipticalCylinder(center, majorRadius, minorRadius, height)
' Change the viewing direction of the viewport to better see the cylinder
ZoomAll
End Sub

AddExtrudedSolid Example
Sub Example_AddExtrudedSolid()
' This example extrudes a solid from a region.
' The region is created from an arc and a line.
Dim curves(0 To 1) As AcadEntity
' Define the arc
Dim startAngle As Double
Dim endAngle As Double
radius = 2#
startAngle = 0
endAngle = 3.141592
Set curves(0) = ThisDrawing.ModelSpace.AddArc(centerPoint, radius, startAngle, endAngle)
' Define the line
Set curves(1) = ThisDrawing.ModelSpace.AddLine(curves(0).startPoint, curves(0).endPoint)
' Create the region
' Define the extrusion
Dim taperAngle As Double
height = 3
taperAngle = 0
' Create the solid
Set solidObj = ThisDrawing.ModelSpace.AddExtrudedSolid(regionObj(0), height, taperAngle)
ZoomAll
End Sub

AddExtrudedSolidAlongPath Example
Sub Example_AddExtrudedSolidAlongPath()
' This example extrudes a solid from a region
' along a path defined by a spline.
' Define the arc
radius = 2#
startAngle = 0
endAngle = 3.141592
' Define the line
' Create the region
' Define the extrusion path (spline object)
' Define the Spline Object
startTan(0) = 10: startTan(1) = 10: startTan(2) = 10
endTan(0) = 10: endTan(1) = 10: endTan(2) = 10
Set splineObj = ThisDrawing.ModelSpace.AddSpline(fitPoints, startTan, endTan)
' Create the solid
Set solidObj = ThisDrawing.ModelSpace.AddExtrudedSolidAlongPath(regionObj(0), splineObj)
ZoomAll
AddHatch Example

Sub Example_AddHatch()
' This example creates an associative gradient hatch in model space.
Dim hatchObj As AcadHatch
Dim patternName As String
Dim PatternType As Long
Dim bAssociativity As Boolean
' Define the hatch
patternName = "CYLINDER"
PatternType = acPreDefinedGradient '0
bAssociativity = True
' Create the associative Hatch object in model space
Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity, acGradientObject)
Dim col1 As AcadAcCmColor, col2 As AcadAcCmColor
Set col1 = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")
Set col2 = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")
Call col1.SetRGB(255, 0, 0)
Call col2.SetRGB(0, 255, 0)
hatchObj.GradientColor1 = col1
hatchObj.GradientColor2 = col2
' Create the outer boundary for the hatch (a circle)
Dim outerLoop(0 To 0) As AcadEntity
radius = 1
Set outerLoop(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)
' Append the outerboundary to the hatch object, and display the hatch
hatchObj.AppendOuterLoop (outerLoop)
hatchObj.Evaluate
ThisDrawing.Regen True
End Sub
AddItems Example
Sub Example_AddItems()
' This example creates a selection set and several objects.
' It then adds the objects to the selection set.
' Create the new selection set
Dim ssetObj As AcadSelectionSet
Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_SELECTIONSET")

' Create a Ray object in model space
Dim rayObj As AcadRay
basePoint(0) = 3#: basePoint(1) = 3#: basePoint(2) = 0#
Set rayObj = ThisDrawing.ModelSpace.AddRay(basePoint, SecondPoint)
' Create a polyline object in model space
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
' Create a line object in model space
startPoint(0) = 0: startPoint(1) = 0: startPoint(2) = 0
endPoint(0) = 2: endPoint(1) = 2: endPoint(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
' Create a circle object in model space
Dim circObj As AcadCircle
Dim centerPt(0 To 2) As Double
centerPt(0) = 20: centerPt(1) = 30: centerPt(2) = 0
radius = 3
Set circObj = ThisDrawing.ModelSpace.AddCircle(centerPt, radius)
' Create an ellipse object in model space
radRatio = 0.3
ZoomAll
' Iterate through the model space collection.
' Collect the objects found into an array of objects
' to be added to the selection set.
ReDim ssobjs(0 To ThisDrawing.ModelSpace.count - 1) As AcadEntity

Dim I As Integer
For I = 0 To ThisDrawing.ModelSpace.count - 1
Set ssobjs(I) = ThisDrawing.ModelSpace.Item(I)
Next
' Add the array of objects to the selection set
ssetObj.AddItems ssobjs
ThisDrawing.Regen acActiveViewport
End Sub
AddLeader Example
Sub Example_AddLeader()
' This example creates a leader in model space.
' The leader is not attached to any annotation object
' in this example.
Dim leaderObj As AcadLeader
Dim leaderType As Integer
Dim annotationObject As AcadObject
leaderType = acLineWithArrow
Set annotationObject = Nothing
' Create the leader object in model space
Set leaderObj = ThisDrawing.ModelSpace.AddLeader(points, annotationObject, leaderType)
ZoomAll
End Sub
AddLightweightPolyline Example
Sub Example_AddLightWeightPolyline()
' This example creates a lightweight polyline in model space.

' Create a lightweight Polyline object in model space
ZoomAll
End Sub
AddLine Example
Sub Example_AddLine()
' This example adds a line in model space
' Define the start and end points for the line
startPoint(0) = 1#: startPoint(1) = 1#: startPoint(2) = 0#
endPoint(0) = 5#: endPoint(1) = 5#: endPoint(2) = 0#
' Create the line in model space
ZoomAll
End Sub
AddMInsertBlock Example
Sub Example_AddMInsertBlock()
' This example creates a new Block in the current drawing, adds a
' Circle object to the new block, and uses the newly created block
' to create a rectangular array of block references using AddMInsertBlock
Dim centerPoint(0 To 2) As Double, InsertPoint(0 To 2) As Double

Dim newMBlock As AcadMInsertBlock
Dim newBlock As AcadBlock
' Define the Circle object that will be inserted into the block
centerPoint(0) = 0: centerPoint(1) = 0: centerPoint(2) = 0
InsertPoint(0) = 1: InsertPoint(1) = 1: InsertPoint(2) = 0
radius = 0.5
' Create a new block to hold the Circle object
Set newBlock = ThisDrawing.Blocks.Add(centerPoint, "CBlock")
' Add the Circle object to the new block object
Set circleObj = ThisDrawing.Blocks("CBlock").AddCircle(centerPoint, radius)
' Create a rectangular array of Circles using the new block containing the Circle
' and the AddMInsertBlock method
Set newMBlock = ThisDrawing.ModelSpace.AddMInsertBlock(InsertPoint, "CBlock", 1, 1, 1, 1, 2, 2, 1, 1)
MsgBox "A rectangular array has been created from the original block."
End Sub
AddMLine Example
Sub Example_AddMLine()
' This example adds an Mline in model space
Dim mLineObj As AcadMLine
Dim vertexList(0 To 17) As Double
' Define data for new object
vertexList(0) = 4: vertexList(1) = 7: vertexList(2) = 0
Set mLineObj = ThisDrawing.ModelSpace.AddMLine(vertexList)

MsgBox "A new MLine has been added to the drawing."
End Sub
AddMText Example
Sub Example_AddMtext()
' This example creates an MText object in model space.
Dim MTextObj As AcadMText
Dim corner(0 To 2) As Double
Dim width As Double
Dim text As String
corner(0) = 0#: corner(1) = 10#: corner(2) = 0#
width = 10
text = "This is the text String for the mtext Object"
' Creates the mtext Object
Set MTextObj = ThisDrawing.ModelSpace.AddMText(corner, width, text)
ZoomAll
End Sub
AddObject Example
Sub Example_AddObject()
' This example creates a dictionary and adds
' a custom object to that dictionary.
Set dictObj = ThisDrawing.Dictionaries.Add("TEST_DICTIONARY")
' Load the ObjectARX application that defines the custom object.
' Note: The application listed here does not exist and
' will cause an error when run. Change the application name
' to the path and name of your ObjectARX application.
ThisDrawing.Application.LoadArx ("MyARXApp.dll")
' Create the custom object in the dictionary
Dim keyName As String
Dim className As String
Dim customObj As AcadObject

keyName = "OBJ1"
className = "CAsdkDictObject"
Set customObj = dictObj.AddObject(keyName, className)
End Sub
AddPoint Example
Sub Example_AddPoint()
' This example creates a point in model space.
' Define the location of the point
' Create the point
Set pointObj = ThisDrawing.ModelSpace.AddPoint(location)
ZoomAll
End Sub
AddPolyfaceMesh Example
Sub Example_AddPolyfaceMesh()
Dim vertexList(0 To 17) As Double
'Data
Dim FaceList(0 To 7) As Integer
FaceList(0) = 1
FaceList(1) = 2
FaceList(2) = 5

FaceList(3) = 4
FaceList(4) = 2
FaceList(5) = 3
FaceList(6) = 6
FaceList(7) = 5
Dim obj As AcadPolyfaceMesh
Set obj = ModelSpace.AddPolyfaceMesh(vertexList, FaceList)
obj.Update
' Change the viewing direction of the viewport to
' better see the polyface mesh
ZoomAll
End Sub
AddPolyline Example
Sub Example_AddPolyline()
' This example creates a polyline in model space.
Dim plineObj As AcadPolyline
Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points)
ZoomAll
End Sub
AddPViewport Example
Sub Example_AddPViewport()
' This example creates a new paper space viewport

Dim pviewportObj As AcadPViewport
Dim width As Double
' Define the paper space viewport
width = 40
height = 40
' Change from model space to paper space
' Create the paper space viewport
Set pviewportObj = ThisDrawing.PaperSpace.AddPViewport(center, width, height)
ThisDrawing.Regen acAllViewports
End Sub
AddRaster Example
Sub Example_AddRaster()
' This example adds a raster image in model space.
' This example uses a file named "raster.jpg."
' You should change this example to use
' a raster file on your computer.
Dim imageName As String
Dim rasterObj As AcadRasterImage
imageName = "C:raster.jpg"
insertionPoint(0) = 5#: insertionPoint(1) = 5#: insertionPoint(2) = 0#
scalefactor = 1#
rotationAngle = 0
On Error Resume Next
' Creates a raster image in model space
Set rasterObj = ThisDrawing.ModelSpace.AddRaster(imageName, insertionPoint, scalefactor, rotationAngle)
If Err.Description = "File error" Then
MsgBox imageName & " could not be found."
Exit Sub
End If

ZoomExtents
End Sub
AddRay Example
Sub Example_AddRay()
' This example creates a ray in model space.
' Define the ray
' Creates a Ray object in model space
ZoomAll
End Sub
AddRegion Example
Sub Example_AddRegion()
' This example creates a region from an arc and a line.
' Define the arc
radius = 2#
startAngle = 0
endAngle = 3.141592
' Define the line
' Create the region

ZoomAll
End Sub
AddRevolvedSolid Example
Sub Example_AddRevolvedSolid()
' This example creates a solid from a region
' rotated around an axis.
' Define the arc
radius = 2#
startAngle = 0
endAngle = 3.141592
' Define the line
' Create the region
ZoomAll
MsgBox "Revolve the region to create the solid.", , "AddRevolvedSolid Example"
' Define the rotation axis
Dim axisPt(0 To 2) As Double
Dim axisDir(0 To 2) As Double
Dim angle As Double
axisPt(0) = 7: axisPt(1) = 2.5: axisPt(2) = 0
axisDir(0) = 11: axisDir(1) = 1: axisDir(2) = 3
angle = 6.28
' Create the solid
Set solidObj = ThisDrawing.ModelSpace.AddRevolvedSolid(regionObj(0), axisPt, axisDir, angle)
ZoomAll

ZoomAll
MsgBox "Solid created.", , "AddRevolvedSolid Example"
End Sub
AddShape Example
Sub Example_AddShape()
' This example creates a BAT shape from the ltypeshp.shx file.
' Load the shape file containing the shape you wish to create.
' Note: Replace the ltypeshp.shx file name
' with a valid shape file for your system.
On Error GoTo ERRORHANDLER
ThisDrawing.LoadShapeFile ("C:/Program Files/AutoCAD/Support/ltypeshp.shx")
Dim shapeObj As AcadShape
Dim shapeName As String
Dim rotation As Double
' "diode" is defined in es.shx file
shapeName = "BAT"
scalefactor = 1#
rotation = 0# ' Radians
' Create the diode shape object in model space
Set shapeObj = ThisDrawing.ModelSpace.AddShape(shapeName, insertionPoint, scalefactor, rotation)
Exit Sub
ERRORHANDLER:
MsgBox "Cannot find the shape file.", , "AddShape Example"
End Sub
AddSolid Example
Sub Example_AddSolid()
' This example creates a solid in model space.

Dim solidObj As AcadSolid
' Define the solid
' Create the solid object in model space
Set solidObj = ThisDrawing.ModelSpace.AddSolid(point1, point2, point3, point4)
ZoomAll
End Sub
AddSphere Example
Sub Example_AddSphere()
' This example creates a sphere in model space.
Dim sphereObj As Acad3DSolid
radius = 5#
Set sphereObj = ThisDrawing.ModelSpace.AddSphere(centerPoint, radius)
ZoomAll
End Sub
AddSpline Example
Sub Example_AddSpline()
' This example creates a spline object in model space.

' Create the spline
Set splineObj = ThisDrawing.ModelSpace.AddSpline(fitPoints, startTan, endTan)
ZoomAll
End Sub
AddText Example
Sub Example_AddText()
' This example creates a text object in model space.
Dim textObj As AcadText
Dim textString As String
' Define the text object
textString = "Hello, World."
insertionPoint(0) = 2: insertionPoint(1) = 2: insertionPoint(2) = 0
height = 0.5
' Create the text object in model space
Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)
ZoomAll
End Sub
AddTolerance Example
Sub Example_AddTolerance()
' This example creates a tolerance object in model space.
Dim toleranceObj As AcadTolerance

Dim direction(0 To 2) As Double
' Define the tolerance object
textString = "{Fgdt;r}%%vasdf{Fgdt;l}%%vdf%%vxc%%v12{Fgdt;m}%%vsd" & vbCrLf & _
"{Fgdt;t}%%vdfd%%v3dd{Fgdt;l}%%vv%%v%%vxc{Fgdt;m}" & vbCrLf & _
"123"
direction(0) = 1#: direction(1) = 1#: direction(2) = 0#
' Create the tolerance object in model space
Set toleranceObj = ThisDrawing.ModelSpace.AddTolerance(textString, insertionPoint, direction)
ZoomAll
End Sub
AddToolbarButton Example
Sub Example_AddToolbarButton()
' This example creates a new toolbar called TestToolbar and inserts a
' toolbar button into it. The toolbar is then displayed.
' To remove the toolbar after execution of this macro, use the Customize Menu
' option from the Tools menu.
Dim currMenuGroup As acadMenuGroup
Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
' Create the new toolbar
Dim newToolBar As AcadToolbar
Set newToolBar = currMenuGroup.Toolbars.Add("TestToolbar")
' Add a button to the new toolbar
Dim newButton As AcadToolbarItem
Dim openMacro As String
' Assign the macro string the VB equivalent of "ESC ESC _open "
openMacro = Chr(3) & Chr(3) & Chr(95) & "open" & Chr(32)
Set newButton = newToolBar.AddToolbarButton("", "NewButton", "Open a file.", openMacro)
' Display the toolbar
newToolBar.Visible = True
End Sub

AddTorus Example
Sub Example_AddTorus()
' This example creates a torus in model space.
Dim torusObj As Acad3DSolid
Dim torusRadius As Double
Dim tubeRadius As Double
' Define the torus
torusRadius = 15
tubeRadius = 5
' Create the torus
Set torusObj = ThisDrawing.ModelSpace.AddTorus(centerPoint, torusRadius, tubeRadius)
ZoomAll
End Sub
AddTrace Example
Sub Example_AddTrace()
' This example creates a trace in model space.
Dim traceObj As AcadTrace
Dim tracePts(0 To 11) As Double ' 4 (3D) points
' Define the points of the trace
tracePts(0) = 1: tracePts(1) = 1: tracePts(2) = 0
' Turn on the system variable (FILLMODE)
' to fill the outline of the trace
ThisDrawing.SetVariable "FILLMODE", 1

' Create the trace object in model space
Set traceObj = ThisDrawing.ModelSpace.AddTrace(tracePts)
ZoomAll
End Sub
AddVertex Example
Sub Example_AddVertex()
' This example creates a lightweight polyline in model space.
' It then adds a vertex to the polyline.
ZoomAll
MsgBox "Add a vertex to the end of the polyline.", , "AddVertex Example"
' Define the new vertex
Dim newVertex(0 To 1) As Double
newVertex(0) = 4: newVertex(1) = 1
' Add the vertex to the polyline
plineObj.AddVertex 5, newVertex
plineObj.Update
MsgBox "Vertex added.", , "AddVertex Example"
End Sub
AddWedge Example
Sub Example_AddWedge()
' This example creates a wedge in model space.

Dim wedgeObj As Acad3DSolid
Dim width As Double
' Define the wedge
length = 10#: width = 15#: height = 20#
' Create the wedge in model space
Set wedgeObj = ThisDrawing.ModelSpace.AddWedge(center, length, width, height)
ZoomAll
End Sub
AddXLine Example
Sub Example_AddXLine()
' This example creates an XLine in model space.
Dim xlineObj As AcadXline
Dim directionVec(0 To 2) As Double
' Define the xline
directionVec(0) = 1#: directionVec(1) = 1#: directionVec(2) = 0#
' Create the xline in model space
Set xlineObj = ThisDrawing.ModelSpace.AddXline(basePoint, directionVec)
ZoomAll
End Sub
Algorithm Example
Sub Example_Algorithm()
' This example encrypts and saves a file.

Dim acad As New AcadApplication
Dim sp As New AcadSecurityParams
acad.Visible = True
sp.Action = AcadSecurityParamsType.ACADSECURITYPARAMS_ENCRYPT_DATA
sp.Algorithm = AcadSecurityParamsConstants.ACADSECURITYPARAMS_ALGID_RC4
sp.KeyLength = 40
sp.Password = UCase("mypassword") 'AutoCAD converts all passwords to uppercase before applying them
sp.ProviderName = "Microsoft Base Cryptographic Provider v1.0"
sp.ProviderType = 1
acad.ActiveDocument.SaveAs "C:MyDrawing.dwg", , sp
End Sub
Alignment Example
Sub Example_Alignment()
' This example creates a text object in model space and
' demonstrates setting the alignment of the new text string
Dim insertionPoint(0 To 2) As Double, alignmentPoint(0 To 2) As Double
Dim oldPDMODE As Integer
' Define the new Text object
alignmentPoint(0) = 3: alignmentPoint(1) = 3: alignmentPoint(2) = 0
height = 0.5
' Create the Text object in model space
oldPDMODE = ThisDrawing.GetVariable("PDMODE") ' Record existing point style
' Create a crosshair over the text alignment point
' to better visualize the alignment process
Set pointObj = ThisDrawing.ModelSpace.AddPoint(alignmentPoint)
ThisDrawing.SetVariable "PDMODE", 2 ' Set point style to crosshair

' Set the text alignment to a value other than acAlignmentLeft, which is the default.
' Create a point that will act as an alignment reference point
textObj.Alignment = acAlignmentRight
' Create the text alignment reference point and the text will automatically
' align to the right of this point, because the text
' alignment was set to acAlignmentRight
textObj.TextAlignmentPoint = alignmentPoint
MsgBox "The Text object is now aligned to the right of the alignment point"
' Center the text to the alignment point
textObj.Alignment = acAlignmentCenter
MsgBox "The Text object is now centered to the alignment point"
' Reset point style
ThisDrawing.SetVariable "PDMODE", oldPDMODE
End Sub
AltUnitsScale Example
Sub Example_AltUnitsScale()
' This example creates an aligned dimension in model space and
' uses AltUnitsScale to cycle through some common scales
' for the alternate dimension
Dim dimObj As AcadDimAligned
Dim point1(0 To 2) As Double, point2(0 To 2) As Double
point1(0) = 0: point1(1) = 5: point1(2) = 0
point2(0) = 5: point2(1) = 5: point2(2) = 0
location(0) = 5: location(1) = 7: location(2) = 0
' Create an aligned dimension object in model space
Set dimObj = ThisDrawing.ModelSpace.AddDimAligned(point1, point2, location)
' Enable display of alternate units
dimObj.AltUnits = True
' Cycle through some common dimension scales

dimObj.AltUnitsScale = 1 ' Change scale to Inches
MsgBox "The alternate dimension units are now set to inches"
dimObj.AltUnitsScale = 25.4 ' Change scale to Millimeters (default)
MsgBox "The alternate dimension units are now set to millimeters"
dimObj.AltUnitsScale = 2.54 ' Change scale to Centimeters
MsgBox "The alternate dimension units are now set to centimeters"
End Sub
Angle Example
Sub Example_Angle()
' This example adds a line in model space and returns the angle of the new line
Dim startPoint(0 To 2) As Double, endPoint(0 To 2) As Double
' Define the start and end points for the line
MsgBox "The angle of the new Line is: " & lineObj.angle
End Sub
AngleFormat Example
Sub Example_AngleFormat()
' and sets its Angle Format to some common values

' Cycle through some common angle formats
DimPointAngularObj.AngleFormat = acDegreeMinuteSeconds
MsgBox "The angle format of the new Dim3PointAngular object is now set to degree/minute/second"
DimPointAngularObj.AngleFormat = acGrads
MsgBox "The angle format of the new Dim3PointAngular object is now set to grads"
DimPointAngularObj.AngleFormat = acRadians
MsgBox "The angle format of the new Dim3PointAngular object is now set to radians"
End Sub
AngleFromXAxis Example
Sub Example_AngleFromXAxis()
' This example finds the angle, in radians, between the X axis
' and a line defined by two points.
Dim pt1(0 To 2) As Double
Dim pt2(0 To 2) As Double
Dim retAngle As Double
pt1(0) = 2: pt1(1) = 5: pt1(2) = 0
pt2(0) = 5: pt2(1) = 2: pt2(2) = 0
' Return the angle
retAngle = ThisDrawing.Utility.AngleFromXAxis(pt1, pt2)
' Create the line for a visual reference
Set lineObj = ThisDrawing.ModelSpace.AddLine(pt1, pt2)
ZoomAll

' Display the angle found
MsgBox "The angle in radians between the X axis and the line is " & retAngle, , "AngleFromXAxis Example"
End Sub
AngleToReal Example
Sub Example_AngleToReal()
' This example passes several different strings representing
' an angle in different units to be converted to radians.
Dim angAsStr As String
Dim unit As Integer
Dim angAsReal As Double
' Convert the angle given in degrees unit to a real
angAsStr = "45"
unit = acDegrees
angAsReal = ThisDrawing.Utility.AngleToReal(angAsStr, unit)
MsgBox "45 degrees converts to " & angAsReal & " radians.", , "AngleAsReal Example"
' Convert the angle given in degrees/minutes/seconds unit to Radians
angAsStr = "45d0' 0"""
unit = acDegreeMinuteSeconds
MsgBox "45 degrees, 0 minutes, 0 seconds converts to " & angAsReal & " radians.", , "AngleAsReal Example"
' Convert the angle given in grads unit to Radians
angAsStr = "50"
unit = acGrads
MsgBox "50 grads converts to " & angAsReal & " radians.", , "AngleAsReal Example"
End Sub
AngleToString Example
Sub Example_AngleToString()
' This example converts a radian value to several different
' strings representing the value in different units.
Dim angAsRad As Double
Dim unit As Integer
Dim precision As Long

Dim angAsString As String
angAsRad = 0.785398163397448
unit = acDegrees
precision = 6
' Convert the radian value to degrees with a precision of 6
angAsString = ThisDrawing.Utility.AngleToString(angAsRad, unit, precision)
MsgBox "0.785398163397448 radians = " & angAsString & " degrees", , "AngleAsString Example"
' Convert the radian value to degrees/Minutes/Seconds with a precision of 6
unit = acDegreeMinuteSeconds
MsgBox "0.785398163397448 radians = " & angAsString, , "AngleAsString Example"
' Convert the radian value to grads with a precision of 6
unit = acGrads
MsgBox "0.785398163397448 radians = " & angAsString, , "AngleAsString Example"
End Sub
AngleVertex Example
Sub Example_AngleVertex()
' and then alters its angle vertex
Dim AngleVertex(0 To 2) As Double, NewAngleVertex(0 To 2) As Double
Dim CurrentVertex As Variant
NewAngleVertex(0) = 1: NewAngleVertex(1) = 1: NewAngleVertex(2) = 0
' Display current vertex
CurrentVertex = DimPointAngularObj.AngleVertex
MsgBox "The angle vertex of the new object is set to:" & vbCrLf & _

CurrentVertex(0) & vbCrLf & _
CurrentVertex(2)
' Alter vertex setting for this object
DimPointAngularObj.AngleVertex = NewAngleVertex
' Display new vertex settings
CurrentVertex = DimPointAngularObj.AngleVertex
MsgBox "The angle vertex of the object has been reset to:" & vbCrLf & _
CurrentVertex(2)
End Sub
Application Example
Sub Example_Application()
' This example creates a line and then uses the
' Application property of the line to return the
' application name.
Dim myApp As AcadApplication
' Create a new line reference
lineObj.Update
' Return the application for the object
Set myApp = lineObj.Application
' Display the name of the application
MsgBox "The application name is: " & myApp.name, vbInformation, "Application Example"
End Sub
ArcLength Example
Sub Example_ArcLength()

' This example creates an Arc in model space and returns the length of the new Arc
Dim arcObj As AcadArc
Dim startAngleInDegree As Double, endAngleInDegree As Double
Dim startAngleInRadian As Double, endAngleInRadian As Double
' Define the Arc
radius = 5#
startAngleInDegree = 10#: endAngleInDegree = 230#
' Convert the angles in degrees to angles in radians
startAngleInRadian = startAngleInDegree * 3.141592 / 180#
endAngleInRadian = endAngleInDegree * 3.141592 / 180#
' Create the arc object in model space
Set arcObj = ThisDrawing.ModelSpace.AddArc(centerPoint, radius, startAngleInRadian, endAngleInRadian)
' Return length of new arc
MsgBox "The length of the new Arc is: " & arcObj.ArcLength
End Sub
Area Example
Sub Example_Area()
' This example creates a polyline object and
' then uses the area property to find the
' area of that polyline.
Dim plineArea As Double
' Establish the points for the Polyline
' Create the polyline in model space
' Close the polyline and update display of it
plineObj.Update

ZoomAll
' Get the area of the polyline
plineArea = plineObj.Area
MsgBox "The area of the new Polyline is: " & plineArea, vbInformation, "Area Example"
End Sub
ArrayPolar Example
Sub Example_ArrayPolar()
' This example creates a circle and then performs a polar array
' on that circle.
' Create the circle
radius = 1
Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)
ZoomAll
MsgBox "Perform the polar array on the circle.", , "ArrayPolar Example"
' Define the polar array
Dim noOfObjects As Integer
Dim angleToFill As Double
Dim basePnt(0 To 2) As Double
noOfObjects = 4
angleToFill = 3.14 ' 180 degrees
basePnt(0) = 4#: basePnt(1) = 4#: basePnt(2) = 0#
' The following example will create 4 copies of an object
' by rotating and copying it about the point (3,3,0).
Dim retObj As Variant
retObj = circleObj.ArrayPolar(noOfObjects, angleToFill, basePnt)
ZoomAll
MsgBox "Polar array completed.", , "ArrayPolar Example"
End Sub
ArrayRectangular Example
Sub Example_ArrayRectangular()

' This example creates a circle and then performs
' a rectangular array on that circle.
' Create the circle
radius = 0.5
Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)
MsgBox "Perform the rectangular array on the circle.", , "ArrayRectangular Example"
' Define the rectangular array
Dim numberOfRows As Long
Dim numberOfColumns As Long
Dim numberOfLevels As Long
Dim distanceBwtnRows As Double
Dim distanceBwtnColumns As Double
Dim distanceBwtnLevels As Double
numberOfRows = 5
numberOfColumns = 5
numberOfLevels = 2
distanceBwtnRows = 1
distanceBwtnColumns = 1
distanceBwtnLevels = 1
' Create the array of objects
Dim retObj As Variant
retObj = circleObj.ArrayRectangular(numberOfRows, numberOfColumns, numberOfLevels, distanceBwtnRows,
distanceBwtnColumns, distanceBwtnLevels)
ZoomAll
MsgBox "Rectangular array completed.", , "ArrayRectangular Example"
End Sub
Arrowhead1Block Example
Sub Example_ArrowHead1Block()
' This example creates an aligned dimension object in model space
' and then alters the visible appearance (shape) of the arrowhead
' using the ArrowHeadBlock property.
' Use the ArrowHeadBlock property to set the arrowhead to an existing
' block object containing a custom Circle object

Dim BlockName As String
ZoomAll
' Set arrowhead type to user-defined to allow
' the use of a block as the new arrowhead
'dimObj.ArrowheadType = acArrowUserDefined
DimPointAngularObj.Arrowhead1Block = "CBlock"
DimPointAngularObj.Arrowhead2Block = "CBlock"
ZoomAll
' Read and display current arrowhead block name
BlockName = DimPointAngularObj.Arrowhead1Block
MsgBox "The arrowhead block name for this object is: " & BlockName
End Sub
AutoSnapAperture Example
Sub Example_AutoSnapAperture()
' This example reads and modifies the preference value that controls
' the display of the AutoSnap aperture.
' When finished, this example resets the preference value back to
' its original value.
Dim ACADPref As AcadPreferencesDrafting
Dim originalValue As Variant, newValue As Variant
' Get the drafting preferences object
Set ACADPref = ThisDrawing.Application.preferences.Drafting
' Read and display the original value
originalValue = ACADPref.AutoSnapAperture
MsgBox "The AutoSnapAperture preference is set to: " & originalValue

' Modify the AutoSnapAperture preference by toggling the value
ACADPref.AutoSnapAperture = Not (originalValue)
newValue = ACADPref.AutoSnapAperture
MsgBox "The AutoSnapAperture preference has been set to: " & newValue
' Reset the preference back to its original value
'
' * Note: Comment out this last section to leave the change to
' this preference in effect
ACADPref.AutoSnapAperture = originalValue
MsgBox "The AutoSnapAperture preference was reset back to: " & originalValue
End Sub
AutoSnapApertureSize Example
Sub Example_AutoSnapApertureSize()
' the size of the AutoSnap aperture. When finished, this example resets
' the preference value back to its original value.
originalValue = ACADPref.AutoSnapApertureSize
MsgBox "The AutoSnapApertureSize preference is: " & originalValue
' Modify the AutoSnapApertureSize preference by setting it to 25
ACADPref.AutoSnapApertureSize = 25
newValue = ACADPref.AutoSnapApertureSize
MsgBox "The AutoSnapApertureSize preference has been set to: " & newValue
'
ACADPref.AutoSnapApertureSize = originalValue
MsgBox "The AutoSnapApertureSize preference was reset back to: " & originalValue
End Sub
AutoSnapMagnet Example

Sub Example_AutoSnapMagnet()
' the AutoSnap magnet. When finished, this example resets the
' preference value back to its original value.
originalValue = ACADPref.AutoSnapMagnet
MsgBox "The AutoSnapMagnet preference is set to: " & originalValue
' Modify the AutoSnapMagnet preference by toggling the value
ACADPref.AutoSnapMagnet = Not (originalValue)
newValue = ACADPref.AutoSnapMagnet
MsgBox "The AutoSnapMagnet preference has been set to: " & newValue
'
ACADPref.AutoSnapMagnet = originalValue
MsgBox "The AutoSnapMagnet preference was reset back to: " & originalValue
End Sub
AutoSnapMarker Example
Sub Example_AutoSnapMarker()
' the AutoSnap marker. When finished, this example resets the
' preference value back to its original value.
originalValue = ACADPref.AutoSnapMarker
MsgBox "The AutoSnapMarker preference is set to: " & originalValue
' Modify the AutoSnapMarker preference by toggling the value

ACADPref.AutoSnapMarker = Not (originalValue)
newValue = ACADPref.AutoSnapMarker
MsgBox "The AutoSnapMarker preference has been set to: " & newValue
'
ACADPref.AutoSnapMarker = originalValue
MsgBox "The AutoSnapMarker preference was reset back to: " & originalValue
End Sub
BackgroundFill Example
Sub Example_BackgroundFill()
' This example creates a circle and an MText object, and masks part of the
' circle with the MText object
'Draw a circle
Dim CircleReference(0 To 2) As Double
CircleReference(0) = 0
radius = 5
Set circleObj = ThisDrawing.ModelSpace.AddCircle(CircleReference, radius)
ZoomAll
MsgBox ("A circle has been drawn.")
'Create an MText object with the BackgroundFill property set to True
Dim MTextObj As AcadMText
Dim width As Double
Dim text As String
width = 10
text = "This is the text for the MText object"
Set MTextObj = ThisDrawing.ModelSpace.AddMText(CircleReference, width, text)
MTextObj.BackgroundFill = True
ZoomAll
End Sub
Backward Example
Sub Example_Backward()

' This example creates a text object in model space and
' uses the Backward property to flip the text horizontally
' Define the new Text object
height = 0.5
' Create the Text object in model space
MsgBox "The Text oject is now forward"
textObj.Backward = True
MsgBox "The Text object is now backward"
End Sub
BasePoint Example
Sub Example_BasePoint()
' This example creates a ray object. It then finds the
' base point of the ray, changes the base point, and
' queries the new base point.
Dim directionVec(0 To 2) As Double
' Establish the base point and directional vector for the ray
directionVec(0) = 1#: directionVec(1) = 1#: directionVec(2) = 0#
Set rayObj = ThisDrawing.ModelSpace.AddRay(basePoint, directionVec)
MsgBox "A new Ray has been added.", vbInformation
' Define a new base point

Dim newBase(0 To 2) As Double
newBase(0) = 4#: newBase(1) = 2#: newBase(2) = 0#
' Update the ray using the new base point
rayObj.basePoint = newBase
' Query the new basepoint for the Ray
Dim currBase As Variant ' Note that return from basepoint property is Variant and not a SafeArray
Dim msg As String
currBase = rayObj.basePoint
msg = currBase(0) & ", " & currBase(1) & ", " & currBase(2)
MsgBox "We've just changed the basepoint of the new Ray to: " & msg, vbInformation
End Sub
BeginClose Example
Private Sub AcadDocument_BeginClose()
' This example intercepts a drawing BeginClose event.
'
' This event is triggered when a drawing receives a request to close.
'
' To trigger this example event: Close an open drawing
MsgBox "A drawing has just been closed!"
End Sub
BeginCommand Example
Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
' This example intercepts a drawing BeginCommand event.
'
' This event is triggered when a drawing receives
' any command compatible with this event.
'
' To trigger this example event: Issue any command to an open drawing from
' either the command line, VBA, the AutoCAD menus, the AutoCAD toolbars, or LISP.
' Use the "CommandName" variable to determine which command was started
MsgBox "A drawing has just been issued a " & CommandName & " command."
End Sub

BeginDocClose Example
Private Sub AcadDocument_BeginDocClose(Cancel As Boolean)
' This example prevents a drawing from closing.
Cancel = True
MsgBox "Please do not close this drawing."
End Sub
Circumference Example
Sub Example_Circumference()
' This example creates a Circle object in model space and
' returns the circumference of the Circle
' Define the new Circle object
radius = 5#
' Create the Circle object in model space
Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPoint, radius)
MsgBox "The circumference of the new Circle is: " & circleObj.Circumference
End Sub
Color Example
Sub Example_Color()
' This example creates a polyline and colors it red.
' It then displays the current color setting for the polyline.
Dim plineObj As AcadPolyline
Dim currentcolor As Variant

' Create Polyline
Dim points(8) As Double
Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points)
' First set the color of the object to Red
plineObj.Color = acRed
ThisDrawing.Regen (True)
' Now retrieve and display the Color property
currentcolor = plineObj.Color
' Translate the color from a number into text
If currentcolor = 256 Then
currentcolor = "By Layer"
Else
currentcolor = Choose(currentcolor + 1, "By Block", "Red", "Yellow", "Green", "Cyan", "Blue", "Magenta", "White")
End If
' Display
MsgBox "The Polyline color is: " & currentcolor, vbInformation, "Color Example"
End Sub
ColorIndex Example
Sub Example_ColorIndex()
'This example draws a circle and
'returns the closest color index.
Dim pt(0 To 2) As Double
Set cir = ThisDrawing.ModelSpace.AddCircle(pt, 2)
cir.TrueColor = col
ZoomAll
Dim retCol As AcadAcCmColor
Set retCol = cir.TrueColor
If col.ColorMethod = AutoCAD.acColorMethodByRGB Then

MsgBox "Closest ColorIndex=" & col.ColorIndex
End If
End Sub
ColorMethod Example
Sub Example_ColorMethod()
' This example shows how to change the
' ColorMethod property
col.ColorMethod = AutoCAD.acColorMethodForeground
'Circle number one
Dim cir1 As AcadCircle
Set cir1 = ThisDrawing.ModelSpace.AddCircle(pt, 2)
cir1.TrueColor = col
ZoomAll
Set retCol = cir1.TrueColor
'Message box with method and index
Dim MethodText As String
MethodText = col.ColorMethod
MsgBox "ColorMethod=" & MethodText & vbCrLf & "Index=" & col.ColorIndex
'Circle number two
ZoomAll
col.ColorMethod = AutoCAD.acColorMethodByBlock
'Circle number three
ZoomAll
Dim layColor As AcadAcCmColor
Set layColor = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")
Call layColor.SetRGB(122, 199, 25)

ThisDrawing.ActiveLayer.TrueColor = layColor
col.ColorMethod = AutoCAD.acColorMethodByLayer
Set retCol = cir3.TrueColor
End Sub
ColorName Example
Sub Example_ColorName()
'This example draws a circle and
'returns the color name and color book name of the color.
Call col.SetNames("MyColor", "MyColorBook")
Set cir = ThisDrawing.ModelSpace.AddCircle(pt, 2)
cir.TrueColor = col
ZoomAll
Set retCol = cir.TrueColor
MsgBox "BookName=" & col.BookName
MsgBox "ColorName=" & col.ColorName
End Sub
GetColor Example
Sub Example_GetColor()
' This example creates a TableStyle object and sets values for
' the style name and other attributes.
Dim dictionaries As AcadDictionaries
Set dictionaries = ThisDrawing.Database.dictionaries

Set dictObj = dictionaries.Item("acad_tablestyle")
' Create the custom TableStyle object in the dictionary
Dim keyName As String
Dim className As String
Dim customObj As AcadTableStyle
keyName = "NewStyle"
className = "AcDbTableStyle"
Set customObj = dictObj.AddObject(keyName, className)
customObj.Name = "NewStyle"
customObj.Description = "New Style for My Tables"
customObj.FlowDirection = acTableBottomToTop
customObj.HorzCellMargin = 0.22
customObj.BitFlags = 1
customObj.SetTextHeight AcRowType.acDataRow+AcRowType.acTitleRow, 1.3
col.SetRGB 12, 23, 45
customObj.SetBackgroundColor AcRowType.acDataRow + AcRowType.acTitleRow, col
customObj.SetBackgroundColorNone AcRowType.acDataRow + AcRowType.acTitleRow, False
customObj.SetGridVisibility AcGridLineType.acHorzInside + AcGridLineType.acHorzTop _
,AcRowType.acDataRow + AcRowType.acTitleRow, True
customObj.SetAlignment AcRowType.acDataRow + AcRowType.acTitleRow, acBottomRight
col.SetRGB 244, 0, 0
customObj.SetGridColor 3, 1, col
MsgBox "Table Style Name = " & customObj.Name & vbCrLf & _
"Style Description = " & customObj.Description & vbCrLf & _
"Flow Direction = " & customObj.FlowDirection & vbCrLf & _
"Horzontal Cell Margin = " & customObj.HorzCellMargin & vbCrLf & _
"Bit Flags = " & customObj.BitFlags & vbCrLf & _
"Title Row Text Height = " & customObj.GetTextHeight(acTitleRow) & vbCrLf & _
"Grid Visibility for HorizontalBottom TitleRow = " & customObj.GetGridVisibility(acHorzBottom, acTitleRow) &
vbCrLf & _
"Title Row Alignment = " & customObj.GetAlignment(acTitleRow) & vbCrLf & _
"Header Suppression = " & customObj.HeaderSuppressed
End Sub
LinetypeScale Example
Sub Example_LinetypeScale()

' This example creates a line and finds the linetype scale
' for the line. It then changes the linetype scale, and finally
' resets the linetype scale back to the original value.
Dim currLTScale As Double
' Create a Line object in model space
startPoint(0) = 2#: startPoint(1) = 2#: startPoint(2) = 0#
endPoint(0) = 4#: endPoint(1) = 4#: endPoint(2) = 0#
lineObj.Update
currLTScale = lineObj.LinetypeScale
MsgBox "The linetype scale for the line is:" & lineObj.LinetypeScale, vbInformation, "Linetypes Example"
' Set the linetype scale of a Line to .5
lineObj.LinetypeScale = 0.5
lineObj.Update
MsgBox "The new linetype scale for the line is:" & lineObj.LinetypeScale, vbInformation, "Linetypes Example"
' Reset the linetype scale of a Line to what is was before
lineObj.LinetypeScale = currLTScale
lineObj.Update
MsgBox "The linetype scale for the line is reset to:" & lineObj.LinetypeScale, vbInformation, "Linetypes Example"
End Sub
Mirror Example
Sub Example_Mirror()
' This example creates a lightweight polyline
' and then mirrors that polyline.
ZoomAll

' Define the mirror axis
MsgBox "Mirror the polyline.", , "Mirror Example"
' Mirror the polyline
Dim mirrorObj As AcadLWPolyline
Set mirrorObj = plineObj.Mirror(point1, point2)
ZoomAll
MsgBox "Mirror completed.", , "Mirror Example"
End Sub
Mirror3D Example
Sub Example_Mirror3D()
' This example creates a box in model space, and mirrors the box about a plane.
' Define the box
' Define the mirroring plane with three points
Dim mirrorPt1(0 To 2) As Double
mirrorPt1(0) = 1.25: mirrorPt1(1) = 0: mirrorPt1(2) = 0
' Mirror the box
Dim mirrorBoxObj As Acad3DSolid
Set mirrorBoxObj = boxObj.Mirror3D(mirrorPt1, mirrorPt2, mirrorPt3)

ZoomAll
End Sub
Rotate Example
Sub Example_Rotate()
' This example creates a lightweight polyline
' and then rotates that polyline.
ZoomAll
MsgBox "Rotate the polyline by 45 degrees.", , "Rotate Example"
' Define the rotation
rotationAngle = 0.7853981 ' 45 degrees
' Rotate the polyline
plineObj.Rotate basePoint, rotationAngle
ZoomAll
MsgBox "Rotation completed.", , "Rotate Example"
End Sub

Rotate3D Example
Sub Example_Rotate3D()
' It then rotates the box about an axis.
' Define the box
' Define the rotation axis with two points
Dim rotatePt1(0 To 2) As Double
Dim rotatePt2(0 To 2) As Double
Dim rotateAngle As Double
rotatePt1(0) = -3: rotatePt1(1) = 4: rotatePt1(2) = 0
rotatePt2(0) = -3: rotatePt2(1) = -4: rotatePt2(2) = 0
rotateAngle = 30
rotateAngle = rotateAngle * 3.141592 / 180#
' Draw a line between the two axis points so that it is visible.
' This is optional. It is not required for the rotation.
Dim axisLine As AcadLine
Set axisLine = ThisDrawing.ModelSpace.AddLine(rotatePt1, rotatePt2)
axisLine.Update
MsgBox "Rotate the box 30 degrees about the axis shown.", , "Rotate3D Example"
' Rotate the box
boxObj.Rotate3D rotatePt1, rotatePt2, rotateAngle
MsgBox "The box is rotated 30 degrees.", , "Rotate3D Example"
End Sub

Rotation Example
Sub Example_Rotation()
' It then changes the Rotation of the text object.
height = 0.5
ZoomAll
MsgBox "The Rotation is " & textObj.rotation, vbInformation, "Rotation Example"
' Change the value of the Rotation to 45 degrees (.707 radians)
textObj.rotation = 0.707
ZoomAll
MsgBox "The Rotation is set to " & textObj.rotation, vbInformation, "Rotation Example"
End Sub
ScaleFactor Example
Sub Example_ScaleFactor()
' It then finds the current scale factor and changes it.
height = 0.5
ZoomAll

' Find the current scale factor for the text object
Dim currScaleFactor As Double
currScaleFactor = textObj.scalefactor
MsgBox "The scale factor of the text is " & textObj.scalefactor, , "ScaleFactor Example"
' Change the scale factor for the text object
textObj.scalefactor = currScaleFactor + 1
MsgBox "The scale factor of the text is now " & textObj.scalefactor, , "ScaleFactor Example"
End Sub
SliceSolid Example
Sub Example_SliceSolid()
' It then slices the box based on a plane
' defined by three points. The slice is returned
' as a 3Dsolid.
' Define the box
' Define the section plane with three points
' slice the box
Dim sliceObj As Acad3DSolid
Set sliceObj = boxObj.SliceSolid(slicePt1, slicePt2, slicePt3, True)

ZoomAll
End Sub
SolidFill Example
Sub Example_SolidFill()
' whether multilines, traces, solids, all hatches (including solid-fill)
' and wide polylines are filled in.
'
' When finished, this example resets the preference value back to
' its original value.
Dim ACADPref As AcadDatabasePreferences
' Get the user preferences object
Set ACADPref = ThisDrawing.preferences
originalValue = ACADPref.SolidFill
MsgBox "The SolidFill preference is set to: " & originalValue
' Modify the SolidFill preference by toggling the value
ACADPref.SolidFill = Not (ACADPref.SolidFill)
newValue = ACADPref.SolidFill
MsgBox "The SolidFill preference has been set to: " & newValue
'
ACADPref.SolidFill = originalValue
MsgBox "The SolidFill preference was reset back to: " & originalValue
End Sub
ZoomAll Example
Sub Example_ZoomAll()
' This example creates several objects in model space and
' then performs a variety of zooms on the drawing.

radius = 3
radRatio = 0.3
' ZoomAll
MsgBox "Perform a ZoomAll", , "ZoomWindow Example"
ZoomAll
' ZoomWindow

MsgBox "Perform a ZoomWindow using the following coordinates:" & vbCrLf & _
"1.3, 7.8, 0" & vbCrLf & _
"13.7, -2.6, 0", , "ZoomWindow Example"
point1(0) = 1.3: point1(1) = 7.8: point1(2) = 0
point2(0) = 13.7: point2(1) = -2.6: point2(2) = 0
ZoomWindow point1, point2
' ZoomScaled
MsgBox "Perform a ZoomScaled using:" & vbCrLf & _
"Scale Type: acZoomScaledRelative" & vbCrLf & _
"Scale Factor: 2", , "ZoomWindow Example"
Dim scaletype As Integer
scalefactor = 2
scaletype = acZoomScaledRelative
ZoomScaled scalefactor, scaletype
' ZoomExtents
MsgBox "Perform a ZoomExtents", , "ZoomWindow Example"
ZoomExtents
' ZoomPickWindow
MsgBox "Perform a ZoomPickWindow", , "ZoomWindow Example"
ZoomPickWindow
' ZoomCenter
MsgBox "Perform a ZoomCenter using:" & vbCrLf & _
"Center 3, 3, 0" & vbCrLf & _
"Magnification: 10", , "ZoomWindow Example"
Dim zcenter(0 To 2) As Double
Dim magnification As Double
zcenter(0) = 3: zcenter(1) = 3: zcenter(2) = 0
magnification = 10
zoomcenter zcenter, magnification
End Sub
ZoomCenter Example
Sub Example_ZoomCenter()

radius = 3
radRatio = 0.3
' ZoomAll
ZoomAll
' ZoomWindow

"1.3, 7.8, 0" & vbCrLf & _
' ZoomScaled
scalefactor = 2
' ZoomExtents
ZoomExtents
' ZoomPickWindow
ZoomPickWindow
' ZoomCenter
magnification = 10
End Sub
ZoomExtents Example
Sub Example_ZoomExtents()

radius = 3
radRatio = 0.3
' ZoomAll
ZoomAll
' ZoomWindow
"1.3, 7.8, 0" & vbCrLf & _

' ZoomScaled
scalefactor = 2
' ZoomExtents
ZoomExtents
' ZoomPickWindow
ZoomPickWindow
' ZoomCenter
magnification = 10
End Sub
ZoomScaled Example
Sub Example_ZoomScaled()

radius = 3
radRatio = 0.3
' ZoomAll
ZoomAll
' ZoomWindow
"1.3, 7.8, 0" & vbCrLf & _

' ZoomScaled
scalefactor = 2
' ZoomExtents
ZoomExtents
' ZoomPickWindow
ZoomPickWindow
' ZoomCenter
magnification = 10

Programacion VBA para AutoCad 2007 ejemplos

Programacion VBA para AutoCad 2007 ejemplos

Más contenido relacionado

La actualidad más candente (20)

Destacado (20)

Similar a Programacion VBA para AutoCad 2007 ejemplos (20)

Último (20)

Programacion VBA para AutoCad 2007 ejemplos