从Excel创建CAD绘图
大家好，谢谢你们欢迎我，我需要用Excel生成多个autoCAD图形。
我刚刚在youtube上找到了这段美丽的视频，满足了我最初的需求。
有没有人有类似的VBA代码或实际上拥有这段代码，可以极大地帮助我入门？
https://www.youtube.com/watch?v=ASxf-ujfJ4o&t=18秒 我已将您的线程移动到。NET、ObjectARX和VBA论坛。 它似乎是基于Excel的，您可能在Excel VBA网站上运气更好。
我收到一条关于他们在视频中链接的网页的警告，他们似乎也没有回应YouTube网站上的问题。 也许从这个开始，它是在谷歌一次创建一个对象“行VBA excel autocad”等。
几天前有一个帖子也是关于这个的，我想它就在这里。
Sub Opendwg()
Dim acadApp As Object
Dim acadDoc As Object
'Check if AutoCAD application is open. If is not opened create a new instance and make it visible.
On Error Resume Next
Set acadApp = GetObject(, "AutoCAD.Application")
If acadApp Is Nothing Then
Set acadApp = CreateObject("AutoCAD.Application")
acadApp.Visible = True
End If
'Check (again) if there is an AutoCAD object.
If acadApp Is Nothing Then
MsgBox "Sorry, it was impossible to start AutoCAD!", vbCritical, "AutoCAD Error"
Exit Sub
End If
On Error GoTo 0
'If there is no active drawing create a new one.
On Error Resume Next
Set acadDoc = acadApp.ActiveDocument
If acadDoc Is Nothing Then
Set acadDoc = acadApp.Documents.Add
End If
On Error GoTo 0
'Check if the active space is paper space and change it to model space.
If acadDoc.ActiveSpace = 0 Then '0 = acPaperSpace in early binding
acadDoc.ActiveSpace = 1 '1 = acModelSpace in early binding
End If
End Sub
Public Sub addline(x1, y1, z1, x2, y2, z2)
' Create the line in model space
Dim acadApp As Object
Dim acadDoc As Object
Set acadApp = GetObject(, "AutoCAD.Application")
Set acadDoc = acadApp.ActiveDocument
Dim startpoint(0 To 2) As Double
Dim endpoint(0 To 2) As Double
Dim lineobj As Object
startpoint(0) = x1: startpoint(1) = y1: startpoint(2) = z1
endpoint(0) = x2: endpoint(1) = y2: endpoint(2) = z2
Set lineobj = acadDoc.ModelSpace.addline(startpoint, endpoint)
acadApp.ZoomExtents
End Sub
Public Sub addcirc(x1, y1, z1, rad)
' Create the circle in model space
Dim acadApp As Object
Dim acadDoc As Object
Set acadApp = GetObject(, "AutoCAD.Application")
Set acadDoc = acadApp.ActiveDocument
Dim cenpoint(0 To 2) As Double
Dim circobj As Object
cenpoint(0) = x1: cenpoint(1) = y1: cenpoint(2) = z1
Set circobj = acadDoc.ModelSpace.addcircle(cenpoint, rad)
acadApp.ZoomExtents
End Sub
Sub addpoly(cords, col)
Dim acadApp As Object
Dim acadDoc As Object
Set acadApp = GetObject(, "AutoCAD.Application")
Set acadDoc = acadApp.ActiveDocument
Dim oPline As Object
' add pline to Modelspace
Set oPline = acadDoc.ModelSpace.AddLightWeightPolyline(cords)
oPline.Color = col
End Sub
Sub alan1()
' This example adds a line in model space
' Define the start and end points for the line
px1 = 1
px2 = 5
py1 = 1
py2 = 5
pz1 = 0
pz2 = 0
Call addline(px1, py1, pz1, px2, py2, pz2)
End Sub
Sub alan2()
px1 = 1
py1 = 1
pz1 = 0
Radius = 8.5
Call addcirc(px1, py1, pz1, Radius)
End Sub
Sub alan3()
'Dim coords(0 To n) As Double
Dim coords(0 To 5) As Double
coords(0) = -6: coords(1) = 1:
coords(2) = 3: coords(3) = 5:
coords(4) = 7.55: coords(5) = 6.25:
col = 1
Call addpoly(coords, col)
End Sub
页:
[1]