Colaboraciones Visual Basic

Visual Basic Autocad

Trucos, código, etc, etc....

Temario.

1- Transformación por una matriz.

2- identificación de los objetos

3-Intersección de dos sólidos.

4-Extrusión de un sólido

5-Sólido por revolución

6-Sólido a través de un camino.

7- TRASLACIÓN DE UN SÓLIDO

8-ROTACIÓN DE UN SÓLIDO

1- Transformación por una matriz.
Dim lineObj As AcadLine
Dim startPt(0 To 2) As Double
Dim endPt(0 To 2) As Double
startPt(0) = 2: startPt(1) = 1: startPt(2) = 0
endPt(0) = 5: endPt(1) = 1: endPt(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPt, endPt)
lineObj.Update

' Initialize the transMat variable with a transformation matrix
' that will rotate an object by 90 degrees about the point(0,0,0)
' (More examples of transformation matrices are listed below)
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#
transMat(1, 0) = 1#: transMat(1, 1) = 0#: transMat(1, 2) = 0#: transMat(1, 3) = 0#
transMat(2, 0) = 0#: transMat(2, 1) = 0#: transMat(2, 2) = 1#: transMat(2, 3) = 0#
transMat(3, 0) = 0#: transMat(3, 1) = 0#: transMat(3, 2) = 0#: transMat(3, 3) = 1#

' Transform the line using the defined transformation matrix
MsgBox "Transform the line.", , "TransformBy Example"
lineObj.TransformBy (transMat)
ZoomAll
MsgBox "The line is transformed.", , "TransformBy Example"

2- Identificación de los objetos,
Dim rayObj As AcadRay
Dim basePoint(0 To 2) As Double
Dim SecondPoint(0 To 2) As Double
basePoint(0) = 3#: basePoint(1) = 3#: basePoint(2) = 0#
SecondPoint(0) = 1#: SecondPoint(1) = 3#: SecondPoint(2) = 0#
Set rayObj = ThisDrawing.ModelSpace.AddRay(basePoint, SecondPoint)

Dim plineObj As AcadLWPolyline
Dim points(0 To 5) As Double
points(0) = 3: points(1) = 7
points(2) = 9: points(3) = 2
points(4) = 3: points(5) = 5
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
plineObj.Closed = True

Dim lineObj As AcadLine
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) = 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
Dim radius As Double
centerPt(0) = 5: centerPt(1) = 3: centerPt(2) = 0
radius = 3
Set circObj = ThisDrawing.ModelSpace.AddCircle(centerPt, radius)

Dim ellObj As AcadEllipse
Dim majAxis(0 To 2) As Double
Dim center(0 To 2) As Double
Dim radRatio As Double
center(0) = 5#: center(1) = 5#: center(2) = 0#
majAxis(0) = 10: majAxis(1) = 20#: majAxis(2) = 0#
radRatio = 0.3
Set ellObj = ThisDrawing.ModelSpace.AddEllipse(center, majAxis, radRatio)

ZoomAll

Dim entObjectID As Long
Dim entry As AcadEntity
For Each entry In ThisDrawing.ModelSpace
entObjectID = entry.objectID
entry.Highlight (True)
MsgBox "The ObjectID of this object is " & entObjectID, vbInformation, "ObjectID Example"
entry.Highlight (False)
Next

3- Intersección de dos sólidos.
Dim curves(0 To 1) As AcadEntity
Dim centerPoint(0 To 2) As Double
Dim radius As Double
Dim startAngle As Double
Dim endAngle As Double
centerPoint(0) = 5#: centerPoint(1) = 3#: centerPoint(2) = 0#
radius = 2#
startAngle = 0
endAngle = 3.141592
Set curves(0) = ThisDrawing.ModelSpace.AddArc(centerPoint, radius, startAngle, endAngle)

' Define the line
ZoomExtents
Set curves(1) = ThisDrawing.ModelSpace.AddLine(curves(0).startPoint, curves(0).endPoint)

' Create the region
Dim regionObj As Variant
regionObj = ThisDrawing.ModelSpace.AddRegion(curves)
ZoomAll
ZoomExtents
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
Dim solidObj As Acad3DSolid
Set solidObj = ThisDrawing.ModelSpace.AddRevolvedSolid(regionObj(0), axisPt, axisDir, angle)
ZoomAll

' Change the viewing direction of the viewport
Dim NewDirection(0 To 2) As Double
NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
ThisDrawing.ActiveViewport.Direction = NewDirection
ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
ZoomAll
MsgBox "Solid created.", , "AddRevolvedSolid Example"

4-Extrusión de un sólido.
Dim boxObj As Acad3DSolid
Dim boxLength As Double, boxWidth As Double, boxHeight As Double
Dim boxCenter(0 To 2) As Double
boxCenter(0) = 5#: boxCenter(1) = 5#: boxCenter(2) = 0
boxLength = 10#: boxWidth = 7: boxHeight = 10#

' Create the box (3DSolid) object in model space
Set boxObj = ThisDrawing.ModelSpace.AddBox(boxCenter, boxLength, boxWidth, boxHeight)

' Define the cylinder
Dim cylinderObj As Acad3DSolid
Dim cylinderCenter(0 To 2) As Double
Dim cylinderRadius As Double
Dim cylinderHeight As Double
ZoomExtents
cylinderCenter(0) = 0#: cylinderCenter(1) = 0#: cylinderCenter(2) = 0#
cylinderRadius = 5#
cylinderHeight = 20#

' Create the Cylinder (3DSolid) object in model space
Set cylinderObj = ThisDrawing.ModelSpace.AddCylinder(cylinderCenter, cylinderRadius, cylinderHeight)

' Change the viewing direction of the viewport
Dim NewDirection(0 To 2) As Double
NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
ThisDrawing.ActiveViewport.Direction = NewDirection
ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
ZoomAll

' Perform an intersection on the two solids
MsgBox "Perform an intersection on the two solids.", vbOKOnly, "Boolean Example"
boxObj.Boolean acSubtraction, cylinderObj
ThisDrawing.Regen True

MsgBox "Intersection complete.", , "Boolean Example"

5- Sólido por revolución.
Dim curves(0 To 1) As AcadEntity

' Define the arc
Dim centerPoint(0 To 2) As Double
Dim radius As Double
Dim startAngle As Double
Dim endAngle As Double
centerPoint(0) = 5#: centerPoint(1) = 3#: centerPoint(2) = 0#
radius = 2#
startAngle = 0
endAngle = 3.141592
Set curves(0) = ThisDrawing.ModelSpace.AddArc(centerPoint, radius, startAngle, endAngle)

' Define the line
ZoomExtents
Set curves(1) = ThisDrawing.ModelSpace.AddLine(curves(0).startPoint, curves(0).endPoint)

' Create the region
Dim regionObj As Variant
regionObj = ThisDrawing.ModelSpace.AddRegion(curves)
ZoomAll
ZoomExtents
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
Dim solidObj As Acad3DSolid
Set solidObj = ThisDrawing.ModelSpace.AddRevolvedSolid(regionObj(0), axisPt, axisDir, angle)
ZoomAll

' Change the viewing direction of the viewport
Dim NewDirection(0 To 2) As Double
NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
ThisDrawing.ActiveViewport.Direction = NewDirection
ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
ZoomAll
MsgBox "Solid created.", , "AddRevolvedSolid Example"

6-Solido a través de un camino.

Dim curves(0 To 1) As AcadEntity

' Define the arc
Dim centerPoint(0 To 2) As Double
Dim radius As Double
Dim startAngle As Double
Dim endAngle As Double
centerPoint(0) = 5#: centerPoint(1) = 3#: centerPoint(2) = 0#
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
Dim regionObj As Variant
regionObj = ThisDrawing.ModelSpace.AddRegion(curves)

' Define the extrusion path (spline object)
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 Spline Object
startTan(0) = 10: startTan(1) = 10: startTan(2) = 10
endTan(0) = 10: endTan(1) = 10: endTan(2) = 10
fitPoints(0) = 0: fitPoints(1) = 10: fitPoints(2) = 10
fitPoints(0) = 10: fitPoints(1) = 10: fitPoints(2) = 10
fitPoints(0) = 15: fitPoints(1) = 10: fitPoints(2) = 10
Set splineObj = ThisDrawing.ModelSpace.AddSpline(fitPoints, startTan, endTan)

' Create the solid
Dim solidObj As Acad3DSolid
ZoomExtents
Set solidObj = ThisDrawing.ModelSpace.AddExtrudedSolidAlongPath(regionObj(0), splineObj)
ZoomAll

7-TRASLACIÓN DE UN SOLIDO
Dim circleObj(0) As AcadCircle
Dim center(0 To 2) As Double
Dim radius As Double
center(0) = 2#: center(1) = 2#: center(2) = 0#
radius = 0.5
Set circleObj(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)
ZoomAll

' Define the points that make up the move vector
Dim point1(0 To 2) As Double
Dim point2(0 To 2) As Double
point1(0) = 0: point1(1) = 0: point1(2) = 0
point2(0) = 2: point2(1) = 0: point2(2) = 0
Dim regionObj As Variant
ZoomExtents
regionObj = ThisDrawing.ModelSpace.AddRegion(circleObj)

' Define the extrusion
Dim height As Double
Dim taperAngle As Double
height = 20
taperAngle = 0

' Create the solid
Dim solidObj As Acad3DSolid
Set solidObj = ThisDrawing.ModelSpace.AddExtrudedSolid(regionObj(0), height, taperAngle)

'MsgBox "Move the circle 2 units in the X direction.", , "Move Example"

' Move the circle
ZoomExtents
solidObj.Move point1, point2

ZoomAll

8-ROTACIÓN DE UN SÓLIDO

Dim boxObj As Acad3DSolid
Dim length As Double, width As Double, height As Double
Dim center(0 To 2) As Double

' Define the box
center(0) = 5#: center(1) = 5#: center(2) = 0
length = 5#: width = 7: height = 10#

' Create the box (3DSolid) object in model space
Set boxObj = ThisDrawing.ModelSpace.AddBox(center, length, width, height)

' Change the viewing direction of the viewport
Dim NewDirection(0 To 2) As Double
NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
ThisDrawing.ActiveViewport.Direction = NewDirection
ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
ThisDrawing.Regen True

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
ThisDrawing.Regen True

9- Creación de una nueva hoja

Dim templateFileName As String
templateFileName = "c:\AutoCAD\template\ansi-a.dwt"
ThisDrawing.New templateFileName

10- Creación de atributos

Dim insPoint(0 To 2) As Double

Dim Blockref As AcadBlockReference
insPoint(0) = 0: insPoint(2) = 0: insPoint(1) = 0
InsItem = "C:\drawing2.dwg"
Set Blockref = ThisDrawing.ModelSpace.InsertBlock _
(insPoint, InsItem, 1, -1, 1, 0)
ThisDrawing.Application.Update

' Define the attribute definition
height = 1#
mode = acAttributeModeVerify
prompt = "New Prompt"
tag = "New Tag"
value = "New Value"
ZoomExtents
' Create the attribute definition object in model space
'Set attributeObj = ThisDrawing.Blockref.AddAttribute(height, mode, prompt, insertionPoint, tag, value)

ZoomAll

10- Creación de atributos y edición de atributos

' This example creates a block. It then adds attributes to that
' block. The block is then inserted into the drawing to create
' a block reference.

' Create the block
Dim blockObj As AcadBlock
Dim insertionPnt(0 To 2) As Double
insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "TESTBLOCK")

' Define the attribute definition
Dim attributeObj As AcadAttribute
Dim height As Double
Dim mode As Long
Dim prompt As String
Dim insertionPoint(0 To 2) As Double
Dim tag As String
Dim value As String
height = 1#
mode = acAttributeModeVerify
prompt = "Attribute Prompt"
insertionPoint(0) = 5#: insertionPoint(1) = 5#: insertionPoint(2) = 0
tag = "Attribute Tag"
value = "Attribute Value"

' Create the attribute definition object in model space
Set attributeObj = blockObj.AddAttribute(height, mode, prompt, insertionPoint, tag, value)

' Insert the block
Dim blockRefObj As AcadBlockReference
insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "C:\Mis documentos\2004\WEB\modulo 2\BEAM_160.dwg", 1#, 1#, 1#, 0)
ZoomAll

' Get the attributes for the block reference
Dim varAttributes As Variant
varAttributes = blockRefObj.GetAttributes

' Move the attribute tags and values into a string to be displayed in a Msgbox
Dim strAttributes As String
Dim I As Integer
For I = LBound(varAttributes) To UBound(varAttributes)
strAttributes = strAttributes & " Tag: " & varAttributes(I).TagString & _
" Value: " & varAttributes(I).TextString & " "
Next
MsgBox "The attributes for blockReference " & blockRefObj.Name & " are: " & strAttributes, , "GetAttributes Example"

' Change the value of the attribute
' Note: There is no SetAttributes. Once you have the variant array, you have the objects.
' Changing them changes the objects in the drawing.
varAttributes(1).TextString = "NEW VALUE!"

Dim newvarAttributes As Variant
newvarAttributes = blockRefObj.GetAttributes

strAttributes = ""
For I = LBound(varAttributes) To UBound(varAttributes)
strAttributes = strAttributes & " Tag: " & varAttributes(I).TagString & _
" Value: " & varAttributes(I).TextString & " "
Next
MsgBox "The attributes for blockReference " & blockRefObj.Name & " are: " & strAttributes, , "GetAttributes Example"

Editado por RCA

Colabora aquí