日志
-
2014-09-11 18:31
-
Public acadAPP As AcadApplication
阅读全文»分类:默认分类|回复:0|浏览:430
Public acadDoc As AcadDocument
Public ucsOBJ As AcadUCS
Public Sub 连接CAD()
On Error Resume Next
Set acadAPP = GetObject(, "AutoCAD.Application")
'acadAPP.Documents.Add
If Err Then
Err.Clear
Set acadAPP = CreateObject("AutoCAD.Application")
If Err Then
MsgBox Err.Description
Exit Sub
End If
End If
acadAPP.Visible = True
acadAPP.WindowState = acMax
AppActivate acadAPP.Caption
End Sub
-
2014-09-11 18:28
-
将命令发送到 AutoCAD 命令行
阅读全文»分类:默认分类|回复:0|浏览:229
下面的样例创建一个圆心为 (2, 2,0)、半径为 4 的圆,然后将图形缩放至图形中的所有几何图形都可见。注意,在字符串的结尾处有一个空格,表示最后一次按 ENTER 键将开始执行命令。
ThisDrawing.SendCommand "_Circle 2,2,0 4 "
ThisDrawing.SendCommand "_zoom a "
-
2014-09-11 18:22
-
本例提示用户输入五个点,然后根据输入的点创建多段线。该多段线是闭合的,所形成的面积显示在消息框中。
阅读全文»分类:默认分类|回复:0|浏览:238
Dim p1 As Variant
Dim p2 As Variant
Dim p3 As Variant
Dim p4 As Variant
Dim p5 As Variant
' 获取用户输入的点
p1 = acadDoc.Utility.GetPoint(, vbCrLf & "First point: ")
p2 = acadDoc.Utility.GetPoint(p1, vbCrLf & "Second point: ")
p3 = acadDoc.Utility.GetPoint(p2, vbCrLf & "Third point: ")
p4 = acadDoc.Utility.GetPoint(p3, vbCrLf & "Fo ..
-
2014-09-11 18:15
-
本例将捕捉基点更改为(1,1),并将捕捉旋转角更改为 30 度,同时打开栅格以显示这些更改。
阅读全文»分类:默认分类|回复:0|浏览:241
' 打开活动视口的栅格
ThisDrawing.ActiveViewport.GridOn = True
' 将捕捉基点更改为 1, 1
Dim newBasePoint(0 To 1) As Double
newBasePoint(0) = 1: newBasePoint(1) = 1
acadDoc.ActiveViewport.SnapBasePoint = newBasePoint
' 将捕捉旋转角更改为 30 度(0.575 弧度)
Dim rotationAngle As Double
rotationAngle = 0.575
acadDoc.ActiveViewport.SnapRotationAngle = rotationAngle
' 重置视口
acadDoc.Act ..
-
2014-09-11 17:59
-
On Error Resume Next
阅读全文»分类:默认分类|回复:0|浏览:334
Call 连接CAD
'----------------------------------------------------将vba中代码增加下列两行语句
Dim acadDoc As AcadDocument
Set acadDoc = acadAPP.ActiveDocument
'-----------------------------------------------------------将VBA中 ThisDrawing替换为acadDoc
acadDoc.Application.ZoomExtents
'-----------------------------------------------------------将图形最大范围显示
' 本例设置 AutoCAD 图形光标的十字光标
' 设置为全屏。
' 访问 Preferences 对象
..