关于使用VBA调用AutoCAD的学习

本文介绍了如何通过VBA在Excel中调用AutoCAD,以便快速查看大量坐标点之间的相对位置关系。首先,创建并设置AutoCAD应用程序对象,然后在AutoCAD中绘制点。当计算机上安装了多个CAD版本时,可以使用ProgID来指定调用的具体版本。遇到AutoCAD2012与VBA兼容性问题,但作者选择不深入研究,主要关注于实现简单的点位展示功能。
摘要由CSDN通过智能技术生成

如果有很多个坐标点,想简单的看一下彼此之间的相对位置关系,一个很简单的办法,就是展到AutoCAD中。在AutoCAD中逐点输入坐标数据肯定是不现实的,最简答的方法是在Excel中调用AutoCAD:

Global Sheet As Object, acadmtext As acadmtext, fontHight As Double
Global xlBook As Excel.Workbook
Global p0(2) As Double, p1(2) As Double, p2(2) As Double
Global acadApp As Object
Global acadDoc As Object
Global number As Integer, pt(2) As Double
Public Function GetAcad(dwt As String) As Boolean
 Dim Face As String
 Dim Bold As Boolean
 Dim Italic As Boolean
 Dim charSet As Long
 Dim PitchandFamily As Long
 On Error Resume Next
 Set acadApp = GetObject(, "AutoCAD.Application")
 If Err Then
Err.Clear
Set acadApp = CreateObject("AutoCAD.Application")
If Err Then
 MsgBox "请安装AutoCAD 2000以上版本", vbCritical, "autocad"
 Exit Function
 On Error GoTo 0
 GetAcad = False
 Exit Function
End If
 End If
 Set acadDoc = acadApp.ActiveDocument
 acadApp.Visible = True
 GetAcad = True
 acadDoc.ActiveTextStyle.GetFont Face, Bold, Italic, charSet, PitchandFamily
 acadDoc.ActiveTextStyle.SetFont "宋体", Bold, Italic, charSet, PitchandFamily
0:
End Function
Public Function Draw_Point(Point() As Double) As AcadPoint
 Set Draw_Point = acadDoc.ModelSpace.AddPoint(Point)
 Draw_Point.Update
End Function


但如果计算机中装了多个版本的CAD,在调用过程中存在混淆,经查阅资料原来还有ProgID这个东西:

AutoCAD产品名

版本号

Public Sub JJCC() QXAN = 0 On Error Resume Next CXKS If Dir("C:\windows\cxml.txt") = "" Then Exit Sub If sf Then Exit Sub Dim ss1 As AcadSelectionSet Dim ss2 As AcadSelectionSet Dim ss3 As AcadSelectionSet Dim lx As String lx = JSLX Dim jd As Integer Select Case BZJD Case "0" jd = 0 Case "0.0" jd = 1 Case "0.00" jd = 2 Case "0.000" jd = 3 Case "0.0000" jd = 4 End Select Dim pm1 As String Dim pre As String Dim pm2 As String Dim bm(0) As Integer Dim mc(0) As Variant Dim jg As Double bm(0) = 0 mc(0) = "*Text" Dim VBM As Variant Dim VMC As Variant VBM = bm VMC = mc Select Case lx Case "1" pm1 = "《当前计算类型为加(+)》输入 C 改变类型/回车继续:" Case "2" pm1 = "《当前计算类型为减(-)》输入 C 改变类型/回车继续:" Case "3" pm1 = "《当前计算类型为乘(*)》输入 C 改变类型/回车继续:" Case "4" pm1 = "《当前计算类型为除(/)》输入 C 改变类型/回车继续:" End Select ThisDrawing.Utility.Prompt (vbCrLf & pm1) pre = ThisDrawing.Utility.GetString(True) If pre = "C" Or pre = "c" Then QXAN = 0 UserForm1.Show 'If QXAN = 1 Then Exit Sub lx = JSLX Select Case BZJD Case "0" jd = 0 Case "0.0" jd = 1 Case "0.00" jd = 2 Case "0.000" jd = 3 Case "0.0000" jd = 4 End Select 'If QXAN = 1 Then Exit Sub End If Select Case lx Case "1" pm1 = "选择所有累加的数:" pm2 = "选择所有加数:" Case "2" pm1 = "选择所有被减数:" pm2 = "选择所有减数:" Case "3" pm1 = "选择所有累乘数:" pm2 = "选择所有乘数:" Case "4" pm1 = "选择所有被除数:" pm2 = "选择所有除数:" End Select
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值