Plot a set of points (or draw a polyline or a line from VB)

Create a series of non connected lines

Set An = ObjAcad.ActiveDocument.ModelSpace.AddPoint(PP) ' add points (nodes)
Set mylineobject = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)
Set An = ObjAcad.ActiveDocument.ModelSpace.AddLightWeightPolyline(P1)
ZoomExtents

End Sub

 

   If Dir(FileName) <> "" Then
        ThisDrawing.Application.Documents.Open FileName
    Else
        MsgBox("text")
    End If
end sub

Public Sub NewFile()
    Dim docObj As AcadDocument
    Set docObj = ThisDrawing.Application.Documents.Add
End Sub
Public Sub SaveFileAs()
    ThisDrawing.SaveAs "myDrawing.dwg"
End Sub

Public Sub TestIfSaved()
    If ThisDrawing.Saved = False Then
        i = MsgBox("Text", vbYesNo + vbQuestion)
        If i = vbYes Then ThisDrawing.Save
    End If
End Sub

Public Sub CloseFile()
    ThisDrawing.Close
End Sub

Public Sub CloseFile()
    ThisDrawing.Close
End Sub
Public Sub CloseFile()
    TestIfSaved
    ThisDrawing.Close
End Sub

AddText

Add3DFace

' Excel VBA code to run in a worksheet object.
' Set a reference to the AutoCAD 200x Type Library (ACAD.TLB).

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then ' watched cell hard-coded to A:1
Debug.Print "Changed watched cell"
WriteToAcad Target.Value
Else
Debug.Print "Changed other cell"
End If
End Sub

Private Sub WriteToAcad(ByVal sText As String)
Dim oACAD As AutoCAD.AcadApplication
Dim ThisDrawing As AutoCAD.AcadDocument
Dim oText As AutoCAD.AcadText
Dim sDwgName As String
Dim pInsPt(0 To 2) As Double

sDwgName = "C:\Acad\Test\Test.dwg"
pInsPt(0) = 0: pInsPt(1) = 0: pInsPt(2) = 0
Set oACAD = New AutoCAD.AcadApplication
Set ThisDrawing = oACAD.Documents.Open(sDwgName)
Set oText = ThisDrawing.ModelSpace.AddText(sText, pInsPt, 0.25)
ThisDrawing.Close True, sDwgName
oACAD.Quit
Set oText = Nothing
Set ThisDrawing = Nothing
Set oACAD = Nothing
End Sub
 

Open "C:\TEMP\points.TXT" For Input As 1
Dim pp(2) As Double
Dim p1(2), p2(2), p3(2) As Double
I = 0
While EOF(1) = False
I = I + 1
Input #1, A, B, C
pp(0) = A
pp(1) = B
pp(2) = C
Set tmppt = ThisDrawing.ModelSpace.AddPoint(pp)
Wend
Close 1
p1(0) = 5
p1(1) = -2
p1(2) = 1
p1(0) = 1
p2(1) = 0
p2(2) = -2
p3(0) = -1
p3(1) = 2
p3(2) = -4
Set tmpPf = ThisDrawing.ModelSpace.Add3DFace(p1, p2, p3, p1)

 

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
    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 origin(0 To 2) As Double
    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
    

End Sub

Sub Example_ZoomAll()
' This example creates several objects in model space and
' then performs a variety of zooms on the drawing.

' Create a Ray object in model space
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)

' Create a polyline object in model space
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

' Create a line object in model space
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) = 20: centerPt(1) = 30: centerPt(2) = 0
radius = 3
Set circObj = ThisDrawing.ModelSpace.AddCircle(centerPt, radius)

' Create an ellipse object in model space
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
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"

Dim point1(0 To 2) As Double
Dim point2(0 To 2) As Double
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 scalefactor As Double
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
 

Sub Example_AddFitPoint()
' This example creates a spline object in model space.
' It then adds a fit point to the spline.

' Create the spline
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

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
fitPoints(3) = 5: fitPoints(4) = 5: fitPoints(5) = 0
fitPoints(6) = 10: fitPoints(7) = 0: fitPoints(8) = 0

' Create the spline object
Set splineObj = ThisDrawing.ModelSpace.AddSpline(fitPoints, startTan, endTan)
ZoomAll
MsgBox "The Spline has " & splineObj.NumberOfFitPoints & " fit points.", , "AddFitPoint Example"

' Define the new fit point
Dim newFitPoint(0 To 2) As Double
newFitPoint(0) = 8: newFitPoint(1) = 5: newFitPoint(2) = 0

' Add the new fit point at the first index in the spline's array of points
splineObj.AddFitPoint 1, newFitPoint
ThisDrawing.Regen True
MsgBox "A fit point has been added at Index:1 WCS: 8, 5, 0" & vbCrLf & "The Spline has " & splineObj.NumberOfFitPoints & " fit points.", , "AddFitPoint Example"

End Sub

Sub Example_AddPoint()
' This example creates a point in model space.
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)
ZoomAll

End Sub

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 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
Dim height As Double
Dim taperAngle As Double
height = 3
taperAngle = 0

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

' 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

End Sub

Sub Example_Add3DFace()
' This example creates a 3D face in model space.

Dim faceObj As Acad3DFace
Dim point1(0 To 2) As Double
Dim point2(0 To 2) As Double
Dim point3(0 To 2) As Double
Dim point4(0 To 2) As Double

' Define the four coordinates of the face
point1(0) = 0#: point1(1) = 0#: point1(2) = 0#
point2(0) = 5#: point2(1) = 0#: point2(2) = 1#
point3(0) = 1#: point3(1) = 10#: point3(2) = 0#
point4(0) = 5#: point4(1) = 5#: point4(2) = 1#

' Create the 3DFace object in model space
Set faceObj = ThisDrawing.ModelSpace.Add3DFace(point1, point2, point3, point4)
ZoomAll

End Sub
 

Selection

Extrude

Public Sub SelectionSetInfo()
Dim sset As AcadSelectionSet
Dim ACADObj As Variant
Dim i As Integer
Dim fileid As Integer
Dim startpoint As Variant
Dim endpoint As Variant
Dim coordinates As Variant
Dim nmax As Integer

'if sset with the name mentioned above already exists - delete it
For Each sset In ThisDrawing.SelectionSets
If sset.Name = ssetname Then
sset.Delete
Exit For
End If
Next sset
'add new sset
Set sset = ThisDrawing.SelectionSets.Add(ssetname)
'ask user to select something
sset.SelectOnScreen
'if there are no selected objects
If sset.Count = 0 Then
MsgBox "You have not selected any object.", , "Error"
sset.Delete
Exit Sub
End If

fileid = 10
Open FILENAME For Output As #fileid
Open CFLN For Output As 2
'here you can use all sset object properties
'it is important to pay attention on object type
'for example Line object does not have Center Property
'and Circle object does not have EndPoint
'you can not only get some properties but
'set them
'for example you can change object color

For Each ACADObj In sset
Print #fileid, "ID=" & Trim(Str(ACADObj.ObjectID))
Print #fileid, "Name=" & ACADObj.ObjectName
Select Case ACADObj.ObjectName
Case "AcDbLine"
Print #2, "AcDbLine"
startpoint = ACADObj.startpoint
endpoint = ACADObj.endpoint
Print #2, startpoint(0), startpoint(1), startpoint(2), endpoint(0), endpoint(1), endpoint(2)
For i = 0 To 2
Print #fileid, "StartPoint(" & Trim(Str(i)) & ")=" & Trim(Str(startpoint(i)))
Next i
For i = 0 To 2
Print #fileid, "EndPoint(" & Trim(Str(i)) & ")=" & Trim(Str(endpoint(i)))
Next i
Case "AcDbPolyline"
Print #2, "AcDbPolyline"
coordinates = ACADObj.coordinates
For i = 0 To UBound(coordinates)
Print #fileid, "Coordinate(" & Trim(Str(i)) & ")=" & Trim(Str(coordinates(i)))
Next i
nmax = UBound(coordinates)
For i = 0 To nmax / 2 - 1 Step 2
Print #2, Trim(Str(coordinates(i))), Trim(Str(coordinates(i)))
Next i
End Select
ACADObj.color = color
Next ACADObj
Close #fileid
End Sub

Sub Example_AddExtrudedSolid()
' extrude a 3dface defined by a triangle

Dim faceObj As Acad3DFace
Dim point1(0 To 2) As Double
Dim point2(0 To 2) As Double
Dim point3(0 To 2) As Double
Dim point4(0 To 2) As Double

' Define the four coordinates of the face
point1(0) = 0#: point1(1) = 0#: point1(2) = 0#
point2(0) = 5#: point2(1) = 0#: point2(2) = 1#
point3(0) = 1#: point3(1) = 10#: point3(2) = 0#
point4(0) = 5#: point4(1) = 5#: point4(2) = 1#

' Create the 3DFace object in model space
Set faceObj = ThisDrawing.ModelSpace.Add3DFace(point1, point2, point3, point4)
ZoomAll


' Create the region
Dim regionObj As Variant
regionObj = ThisDrawing.ModelSpace.AddRegion(faceObj)

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


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