分享学习AutoCAD编程之VBA笔记 (期初完结！)

kuangben8

12、很有用的Utility对象

A、Utility对象

提供一系列实用工具方法，VBA类名AcadUtility，访问途径：Thisdrawing.Utility

方法	对应作用
AngleFromXAxis	获取直线与 X 坐标轴的夹角。
AngleToReal	将角度从字符串转换为双精度实数值。
AngleToString	将角度从双精度实数值转换为字符串。
CreateTypedArray	创建包含一组各种参数的变体。
DistanceToReal	将距离由字符串转换为实数(双精度)值。
GetAngle	获取指定的角度。考虑 ANGBASE 系统变量的设置。
GetCorner	获取矩形的角点。
GetDistance	获取由提示行或由屏幕上选定的一组点的距离
GetEntity	以交互方式获取对象。
GetInput	将用户输入的字符串转换为关键词索引。
GetInteger	从用户处获取整数值。
GetKeyword	从用户处获取关键词字符串。
GetOrientation	获取指定角度。忽略 ANGBASE 系统变量的设置。
GetPoint	获取  AutoCAD 中选定的点。
GetReal	从用户获取双精度实数值。
GetRemoteFile	下载由URL指定的文件。
GetString	从用户获取字符串。
GetSubEntity	以交互方式获取对象或子图元。
InitializeUserInput	初始化 GetKeyword 方法。
IsRemoteFile	返回下载远程文件的源 URL。
IsURL	验证给定的URL。
LaunchBrowserDialog	启动  Web 浏览器窗口，允许用户导航到任意 URL 并可指定  URL。
PolarPoint	获取与给定点指定角度和距离的点。
Prompt	向命令行发送提示。
PutRemoteFile	将文件上载到由 URL 指定的远程位置。
RealToString	将双精度实数值转换为字符串。
SendModelessOperationEnded	指出非模态操作已经结束。
SendModelessOperationStart	指出非模态操作即将开始。
TranslateCoordinates	将点从一个坐标系转换到另一个坐标系。

属性	对应作用
Application	获取  Application 对象。

% v( b3 \4 ^& U6 o' K
, \7 B  K7 [4 I" O

kuangben8

; J$ z* u9 ^$ K. ^
- W" x) w  n; z& h5 G$ ~/ wB、. AngleFromXAxis方法

RetVal = AngleFromXAxis(Point1, Point2)

Point1、Point2 分别是起点和终点。RetVal是以弧度值表示的线的角度。

1. Sub AngleFromXAxis方法()
   
2.     Dim p1(2) As Double, p2(2) As Double
   
3.     Dim angle As Double
   
4.     p1(0) = 10: p1(1) = 10
   ) Y  h: Q$ s+ T: J  r$ p
5.     p2(0) = 60: p2(1) = 90
   3 y, T, ?# M; ~& J! H9 U/ Q
6. angle = ThisDrawing.Utility.AngleFromXAxis(p1, p2)
   
7. angle = ThisDrawing.Utility.AngleFromXAxis(p2, p1)
   - i; J# ~' D. K, d& d" l6 j
8.     Rem 可以不用画直线而直接获得两点对应直线的角度,注意起点不同的相同直线角度也不同。
   
9. End Sub

复制代码

C、.AngleToReal方法

RetVal = AngleToReal(Angle, Unit)

Angle：String[字符串]; 仅用于输入，以字符串值表示的角度。

Unit：AcAngleUnits 常数; 仅用于输入需要转换到的单位。

acDegrees 将角度字符串转为弧度值   

acDegreeMinuteSeconds 将度分秒字符串转换为弧度值

acGrads 将梯度字符串转换为弧度值                     

acRadians 将弧度字符串转换为弧度值

RetVal：以弧度实数表示的角度。

1. Sub AngleToReal方法()
   3 x" p( y4 O; |; ^
2.     Dim angAsStr As String
   + ]: e& j3 l, g+ p
3.     Dim unit As Integer
   / L% Z$ F/ ~% x6 l( i4 Q
4.     Dim angAsReal As Double
   * C- @4 ~( M5 Y! S, n/ w
5.    
   
6.     angAsStr = "180"
   " S3 M+ ~5 h% D6 K1 Y
7.     unit = acDegrees   '角度转弧度
   
8.     angAsReal = ThisDrawing.Utility.AngleToReal(angAsStr, unit)
   & J) Q4 B% h! Z& ]3 e& q' i' l1 c3 Y+ a
9.     MsgBox "180°转为弧度是 " & angAsReal & " 弧度", , "AngleAsReal 示例"
   0 T* W" ^9 h1 O$ R+ j
10. 
    
11.     angAsStr = "180d0' 0"""
    
12.     unit = acDegreeMinuteSeconds '度分秒转换为弧度
    * W& s: w' V+ z7 f6 t, Z
13.     angAsReal = ThisDrawing.Utility.AngleToReal(angAsStr, unit)
    ! L% Y4 p5 _9 ], u5 j) z: Y; g
14.     MsgBox "180°0’0""转换为弧度是 " & angAsReal & " 弧度", , "AngleAsReal 示例"
    
15.    
    
16.     ' 下面是以梯度单位给出的角度转换为弧度
    4 p0 e7 T% V% F- c$ K4 H1 r0 H
17.     angAsStr = "90"
    
18.     unit = acGrads
    + f$ v7 c# b4 j3 K+ E- t
19.     angAsReal = ThisDrawing.Utility.AngleToReal(angAsStr, unit)
    
20.     MsgBox "90梯度转换为弧度是" & angAsReal & " radians.", , "AngleAsReal 示例"
    7 L$ J+ X7 d+ ^
21.    
    
22.     '下面是将弧度字符串转换为弧度
    % c# u) ^) n0 [9 I
23.     angAsStr = "3.1415926535897932"
    - b7 |; [* \% v6 t: i  N8 @- a/ G8 |
24.     unit = acRadians
    
25.     angAsReal = ThisDrawing.Utility.AngleToReal(angAsStr, unit)
    
26.     MsgBox "π弧度转换为弧度是" & angAsReal & " radians.", , "AngleAsReal 示例"
    ' w# {/ r4 Y$ x9 e2 X0 f1 `- n
27.    
    & Y) Z3 V& \+ {  f& N  B- K5 j
28. End Sub
    

复制代码

D、.AngleToString方法

RetVal = AngleToString(Angle, Unit,Precision)

Angle：double类型，用于输入的值

Unit：AcAngleUnits 单位常数; 仅用于输入

acDegrees 将角度值转为字符串

acDegreeMinuteSeconds 将度分秒值转换字符串

acGrads 将梯度值转为字符串

acRadians 将弧度值转为字符串

Precision：Integer[整数]; 仅用于输入，角度的精度。在 0 到 8 之间的整数。

: v2 r7 Z" {" S. U7 T2 x! @

ReVal：以字符串表示的角度

1. Sub AngleToString方法()
   , X) p$ {! Q) Y' N
2. '此示例将弧度值转换为几个不同的以不同单位表示值的字符串。
   & t4 R3 o* D' V: {+ x- B9 f
3.     Dim angAsRad As Double
   
4.     Dim unit As Integer
   
5.     Dim precision As Long
   1 x5 _5 W+ Z; [+ _8 s1 e" P# y
6.     Dim angAsString As String
   0 I8 D5 N' ~- h; A% W
7.     angAsRad = 3.14159265358979    '以π弧度为例
   9 X5 Y+ M, ]" I6 S& v: x4 y
8.     unit = acDegrees   '将弧度表示的角度转换为字符串
   % `, G2 B9 @* W  u
9.     precision = 6
   
10.    
    1 x4 k8 {+ l' r; U6 W! c
11.     '将弧度值转换为精度为6的度数
    3 |8 w: T" X7 m8 e5 y% a
12.     angAsString = ThisDrawing.Utility.AngleToString(angAsRad, unit, precision)    '结果是 "180" 。
    0 N# s& ^' Q3 v
13.     MsgBox "π弧度= " & angAsString & " 度", , "AngleAsString 示例"
    
14.    
    
15.     ' 将弧度值转换为度/分/秒，精度为6
    
16.     unit = acDegreeMinuteSeconds
    7 N2 C: l. ?3 `8 ^9 _
17.     angAsString = ThisDrawing.Utility.AngleToString(angAsRad, unit, precision)     '结果是 "180d0'0.00"" 。
    * ^3 I2 K2 U3 U: |
18.     MsgBox "π弧度 =  " & angAsString, , "AngleAsString 示例"
    
19.    
    3 n. j3 L/ R3 k3 B1 k
20.     '将弧度值转换为精度为6的梯度值字符串
    
21.     unit = acGrads
    
22.     angAsString = ThisDrawing.Utility.AngleToString(angAsRad, unit, precision)    '结果是 "200g" 。
    6 v; G" {: b& x8 [) _
23.     MsgBox "π弧度=  " & angAsString, , "AngleAsString 示例"
    7 e1 h5 t+ @" s+ i
24.    
    
25.     '将弧度值转换为精度为6的弧度值字符串
    # v) J7 V( @( \4 N: ]
26.     unit = acRadians
    
27.     angAsString = ThisDrawing.Utility.AngleToString(angAsRad, unit, precision)    '结果是 "3.141593r" 。
    - ?9 q& J2 z# b7 R
28.     MsgBox "π弧度=  " & angAsString, , "AngleAsString 示例"
    
29. End Sub
    

复制代码

kuangben8

E、.CreateTypedArray方法

CreateTypedArray(VarArr, Type, Value1,[value2, value3, ...valueN])

VarArr: Variant[变体]; 仅用于输出,作为变体的数组值。

Type: Visual Basic 常数; 仅用于输入用户提供的类型值。
vbBoolean, vbInteger, vbLong, vbSingle, 或 vbDouble。

Value1,……ValueN:在上面 Type 参数中指定的类型; 仅用于输入包含在变体中的值。

说明:结果变体可传递给接受作为变体的数值数组的任何 AutoCAD 方法或属性。该方法只能使用后期绑定编程技术访问。

要使用该方法，可将 Utility 对象定义为 Object (Dim myObj As Object), 而不是 as AcadUtility。

1. Sub CreateTypedArray方法()
   ' E4 O' n; C; \5 \, Y/ l
2. '此示例使用CreateTypedArray方法从Double创建的变量数组创建样条线。
   
3. '请注意，此方法必须是后期绑定的。这是通过将实用程序对象（utilobj）声明为对象而不是AcadUtility来实现的。
   
4.     Dim splineObj As AcadSpline
   " W, r, l6 S5 d, {+ C7 Z7 O0 w
5.     ' 即使这些是数组，它们也被声明为变体变量
   
6.     Dim startTan As Variant
   
7.     Dim endTan As Variant
   
8.     Dim fitPoints As Variant
   
9.     Dim utilObj As Object   ' 后期绑定对象
   - Y  T' d8 \2 F0 J
10.     Set utilObj = ThisDrawing.Utility
    
11.     ' 定义样条曲线.
    
12.     utilObj.CreateTypedArray startTan, vbDouble, 0.5, 0.5, 0
    / v* W8 p" ^2 A9 _$ Z$ M3 j; s1 A
13.     utilObj.CreateTypedArray endTan, vbDouble, 0.5, 0.5, 0
    ; K1 \! f, e- C' i/ y  Q
14.     utilObj.CreateTypedArray fitPoints, vbDouble, 0, 0, 0, 5, 5, 0, 10, 0, 0
    
15.     ' 创建样条曲线
    
16.     Set splineObj = ThisDrawing.ModelSpace.AddSpline(fitPoints, startTan, endTan)
    
17.     ZoomAll
    4 ?; L, _1 j! K. ]1 \2 x- H
18. End Sub

复制代码

) c/ f% c. R$ e8 eF、.GetAngle方法

RetVal = GetAngle([Point][, Prompt])

Point：Variant[变体] (三元素双精度数组); 仅用于输入; 【可选项】指定第一点的三维WCS坐标。

Prompt：Variant[变体] (字符串); 仅用于输入; 【可选项】用于提示用户输入的文字。

RetVal：Double[双精度]，以弧度表示的角度。  

说明

AutoCAD暂停，等待用户输入角度，并设置返回值为已选角度的值。Point 参数指定了角度在二维WCS中的基点。Promp 参数指定在 AutoCAD 暂停时显示的字符串。Point 和 Prompt 参数为可选项。

AutoCAD用户可以通过以当前角度单位格式输入数值来指定角度。用户也可以通过在图形屏幕指定两个二维位置来设置角度。AutoCAD 从第一个点画一条橡皮筋线到当前十字光标位置以便用户看到角度。如果给出了 Point 参数，AutoCAD 用这个值作为两点中的第一点。该角度只测量 WCS 坐标下 XY 平面（GetAngle 忽略点的 Z 轴值）。

虽然 GetAngle 方法是用来指定角度，但它总是把返回值设置为以弧度表示的值。角度的加大方向始终是逆时针。

该函数差不多和GetOrientation一样,但它是按系统变量 ANGBASE 的当前值来计算。对于 GetOrientation，零角度总是向右：“东向”或“时钟的三点”。对于 GetAngle，零角度是 ANGBASE 系统变量的值，该值可设置任何四个90度象限。GetAngle 和 GetOrientation 都返回一个从基准角（零度角）逆时针测量的角的弧度值（实数）。对于 GetAngle，基准等于 ANGBASE 的值；对于 GetOrientation，基准在右侧。两个函数都有当前 ANGDIR 的值，这个值影响当前用户输入的值，但不影响函数的返回值。

可以用 GetAngle 来获得要插入块的旋转量，因为输入0度总是返回0弧度。可用 GetOrientation 来获得一个文字图元的基线角度以便与其它对象对齐。

如果返回的值不是角度而是关键字，AutoCAD 将生成“用户输入关键字”的错误信息。用 GetInput 方法可以从返回值中获得关键字。

用户输入 (角度)	GetAngle  返回值	GetOrientation  返回值
0	0.0	1.5708
-90	1.5708	3.14159
180	3.14159	4.71239
90	4.71239	0.0

1. Sub GetAngle方法()
   
2. '此示例演示了4种不同方法使用getAngle方法从用户检索角度。
   
3.     Dim retAngle As Double
   0 T2 q( U3 V" W# `5 ^4 n6 I
4.     ' 返回以弧度表示的角度并提示
   
5.     retAngle = ThisDrawing.Utility.GetAngle(, "请输入角度: ")         '输入 90 回车
   
6.     MsgBox "被输入的角度是" & retAngle, , "GetAngle 示例"        '返回的是π/2=1.570796....。
   
7.     ' 无提示返回以弧度表示的角度
   
8.     retAngle = ThisDrawing.Utility.GetAngle()      '该写法与上面的区别是：在模型空间的十字光标上没有提示
   
9.     MsgBox "输入的角度是 " & retAngle, , "GetAngle 示例"
   ! r9 G; G4 `4 B& i9 y. W1 R2 F
10.     ' 返回带有提示和角度基点的以弧度表示的角度
    + P, F$ J( ]& D7 B: @  ]
11.     Dim basePnt(0 To 2) As Double
    
12.     basePnt(0) = 2#: basePnt(1) = 2#: basePnt(2) = 0#
    , B1 V' N: Q1 |3 `& e, k
13.     retAngle = ThisDrawing.Utility.GetAngle(basePnt, "请输入角度: ")     '模型空间的十字光标从基点坐标引出一条橡皮筋线跟随光标走
    
14.     MsgBox "输入的角度是： " & retAngle, , "GetAngle 示例"
    
15.     ' 返回带有角度基点但没有提示的弧度角度
    
16.     retAngle = ThisDrawing.Utility.GetAngle(basePnt)
    
17.     MsgBox "输入的角度是：" & retAngle, , "GetAngle 示例"
    $ j/ p+ k6 U. v+ o( K/ c' }
18. End Sub

复制代码

- j" K4 e% ^1 g& x2 K/ j4 D
) I5 u( D. `1 j+ k' i

kuangben8

G、.GetCorner方法

RetVal = GetCorner(Point[, Prompt])     ‘相当于手动画矩形，但不画矩形，而是获取另一角点坐标。

Point：Variant[变体] (三元素双精度数组); 仅用于输入，指定矩形基点的三维WCS坐标点。

Prompt：Variant[变体] (字符串); 仅用于输入; 【可选项】用于提示用户输入的文本。

RetVal：Variant[变体] (三元素双精度数组)，表示矩形框另一角点的三维WCS坐标。

说明

AutoCAD暂停，等待用户输入矩形的角点，然后将返回值设成选取点的值。Point 参数指定了矩形基点的三维WCS坐标；该参数是必需的。Prompt 参数指定了在AutoCAD暂停时显示字符串。该提示是可选项。

AutoCAD用户可以通过输入一个WCS格式的坐标点来指定角点；GetCorner 将点作为一个三维空间的点。用户也可以通过在图形屏幕上指定位置确定角点。AutoCAD从基点到当前十字光标处画出一个有动态大小的矩形来帮助用户认清第二个角点的位置。矩形是在WCS的XY平面中画出。当用点设备时，GetCorner忽略点的Z值，设置Z值的结果为当前标高。

1. Sub GetCorner方法()
   
2. '此示例提供一个基点，并提示用户输入第二个点以生成矩形。
   
3.     Dim returnPnt As Variant
   ' I+ q1 t) O& p4 I$ Z
4.     Dim basePnt(0 To 2) As Double
   & E2 w  o0 S  n
5.     basePnt(0) = 2#: basePnt(1) = 2#: basePnt(2) = 0#
   
6.     ' 提示用户选择第二个点并返回该点坐标
   
7.     returnPnt = ThisDrawing.Utility.GetCorner(basePnt, "请输入另一个角点： ")    '另一个角点可以输入，可以点击选取
   4 j7 @- w* t/ y& Y% {6 |9 P% C5 z/ t; I
8.     ' 显示拾取的点
   " c4 R7 Q! [* j* c; p+ q
9.     MsgBox "拾取的点坐标是 " & returnPnt(0) & ", " & returnPnt(1) & ", " & returnPnt(2), , "GetCorner 示例"
   
10. End Sub

复制代码

H、.GetDistance方法

RetVal = GetDistance([Point][,Prompt])   获取(由提示行或由屏幕上选定的一组点的)距离

Point：Variant[变体] (三元素双精度数组); 仅用于输入;【可选项】指定基点的三维 WCS坐标。如果该点未提供，用户必须输入两个点。

Prompt：Variant[变体] (字符串); 仅用于输入;【可选项】提示用户输入的文本。

RetVal：Variant[变体] (双精度或双精度数组)，从提示行或从屏幕上选定一组点的距离。

说明

AutoCAD暂停，等待用户输入一个线性距离，设置选择的距离为返回值。Point 参数指定了一个WCS坐标系下的基点。Prompt 参数指定了AutoCAD在暂停前显示的字符串。Point 和 Prompt 都是可选的。

AutoCAD用户可以通过输入以当前单位为格式的数值来指定距离。用户也可以通过在图形屏幕上指定两个位置来设置距离。AutoCAD从第一个点到当前十字光标位置画一个橡皮筋线以帮助用户认清距离。如果提供了 Point 参数， AutoCAD将此值作为两个点的第一点值。

默认状态下，GetDistance 把点和返回值看作是三维点。事先调用 InitializeUserInput 方法可以使点成为二维点，以保证该方法返回的是二维平面距离。

本方法除了用于指定距离或当前线性单位（如英尺和英寸），还可经常用来设置双精度浮点的返回值。

1. Sub GetDistance方法()
   
2.     ' 此示例返回用户输入的距离。用户可以输入单个距离值，也可以输入或点选两个点，返回两点的距离。
   4 S9 Q. @* {! ?' ~" |  b: j( m
3.     Dim returnDist As Double
   
4.     Dim basePnt(0 To 2) As Double
   3 |; v! m7 I) V( w1 y
5.     basePnt(0) = 0#: basePnt(1) = 0#: basePnt(2) = 0#
   
6.     ' 返回用户输入的值。提供提示.
   
7.     returnDist = ThisDrawing.Utility.GetDistance(, "请输入距离: ")
   
8.     MsgBox "输入的距离是：" & returnDist & vbCrLf & "(输入下一个值而不提示.)", , "GetDistance 示例"
   
9.     '返回用户输入的值。不提供提示。
   0 C* C7 o1 W! p, H" b0 Y
10.     returnDist = ThisDrawing.Utility.GetDistance()
    
11.     MsgBox "输入的距离是：" & returnDist, , "GetDistance 示例"
    - v; [* f! \- D
12.     ' 返回用户输入的值。提供基点和提示。
    2 \1 T3 L1 i6 C2 E
13.     returnDist = ThisDrawing.Utility.GetDistance(basePnt, "请输入距离: ")
    ' Z& I/ ?9 H; q
14.     MsgBox "输入的距离是：" & returnDist, , "GetDistance 示例"
    
15. End Sub

复制代码

& x9 J: Q/ H9 i
- o- y4 j# [5 N: c6 q

kuangben8

I、.GetEntity方法

object.GetEntity Object, PickedPoint[, Prompt]

Object：Object; 仅用于输出，拾取的对象，可以是任意图形对象中的一个。

PickedPoint：Variant[变体] (三元素双精度数组); 仅用于输出，表示选择点的三维 WCS 坐标。

Prompt：Variant[变体] (字符串); 仅用于输入;【可选项】用于提示用户输入的文本

说明

该方法需要 AutoCAD用户在图形屏幕上拾取一个点来选择一个对象。如果选定了对象，该方法将把它作为第一个参数返回，第二个参数包含了拾取点在WCS下的坐标。如果拾取点不在对象上，该方法调用失败。

GetEntity 返回的拾取点并不需要在已选定的对象上。返回的点只表示选择时十字光标的位置。点与对象的关系会因拾取框的大小和当前的缩放比例而变化。

该方法甚至可以取出在屏幕上不可见的或在冻结层的对象。

1. Sub Example_GetEntity()
   1 _/ ~; I9 T, R' P, Z
2.     '此示例在模型空间中创建多个对象。然后提示用户选择对象。
   : [0 `7 V* u% l8 q
3.     '该示例继续让用户选择对象，直到用户在空白空间中选择。在模型空间中创建一个光线对象。
   
4.     Dim rayObj As AcadRay    '定义射线变量
   
5.     Dim basePoint(0 To 2) As Double
   ( B% W( U$ i, f
6.     Dim SecondPoint(0 To 2) As Double
     h) Z5 F  j; b- @, }
7.     basePoint(0) = 3#: basePoint(1) = 3#: basePoint(2) = 0#
   , ]! Q# v' J% q8 ^
8.     SecondPoint(0) = 1#: SecondPoint(1) = 3#: SecondPoint(2) = 0#
   * r7 T7 v- L1 ]- v
9.     Set rayObj = ThisDrawing.ModelSpace.AddRay(basePoint, SecondPoint)
   ( X5 N+ j$ c* `" ~! v
10.     Update
    : }/ x! K0 D7 g' T. w! K* y
11.     ' 在模型空间中创建多段线对象
    4 E( F6 o- g( N( E7 Z
12.     Dim plineObj As AcadLWPolyline
    
13.     Dim points(0 To 5) As Double
    9 Q% |; }  A( o6 t
14.     points(0) = 3: points(1) = 7
    : Z6 y/ O& n9 o5 G: Z- a5 V3 D
15.     points(2) = 9: points(3) = 2
    & G6 J# ^5 Q$ [  Y
16.     points(4) = 3: points(5) = 5
    / N/ O9 _$ A7 U) O( o( k. l& ^
17.     Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
    3 i. x% {+ C/ H' P  B: W  {+ J
18.     plineObj.Closed = True    '让多段线闭合
    
19.     Update
    
20.     ' 在模型空间中创建线条对象
    
21.     Dim lineObj As AcadLine
    
22.     Dim startPoint(0 To 2) As Double
    
23.     Dim endPoint(0 To 2) As Double
    
24.     startPoint(0) = 0: startPoint(1) = 0: startPoint(2) = 0
    
25.     endPoint(0) = 2: endPoint(1) = 2: endPoint(2) = 0
    $ u9 y2 f* ?/ T# a
26.     Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
    " q+ ~) n& N# x
27.     Update
    
28.     ' 在模型空间中创建圆形对象
    
29.     Dim circObj As AcadCircle
    
30.     Dim centerPt(0 To 2) As Double
    
31.     Dim radius As Double
    * O# p1 [7 n% T. |! R% c9 X
32.     centerPt(0) = 20: centerPt(1) = 30: centerPt(2) = 0
    + O% `3 n' j* ]' N
33.     radius = 3
    
34.     Set circObj = ThisDrawing.ModelSpace.AddCircle(centerPt, radius)
    
35.     Update
    0 o+ N. i- d' r
36.     ' 在模型空间中创建椭圆对象
    
37.     Dim ellObj As AcadEllipse
    
38.     Dim majAxis(0 To 2) As Double
    9 W" d8 ~1 J( R$ c, V$ [1 k" Y
39.     Dim center(0 To 2) As Double
    - t: C) u% T( A$ L5 F% G: \
40.     Dim radRatio As Double
    
41.     center(0) = 5#: center(1) = 5#: center(2) = 0#
    : m# ~1 z" l  q: T
42.     majAxis(0) = 10: majAxis(1) = 20#: majAxis(2) = 0#
    ; z1 O: @* z) W8 f
43.     radRatio = 0.3
    
44.     Set ellObj = ThisDrawing.ModelSpace.AddEllipse(center, majAxis, radRatio)
    0 j8 r) ]5 \7 C+ f  o# f6 m
45.     Update
    " [8 k( O& U+ n1 y& n
46.     ' 开始选择
    & \4 {; r/ m" U2 U8 T
47.     Dim returnObj As AcadObject
    
48.     Dim basePnt As Variant
    
49.     On Error Resume Next
    
50.     ' 下面的示例等待来自用户的选择
    2 h6 z, b1 H3 ~$ }5 o2 b2 I5 l' C* Q- ^
51. RETRY:
    
52.     ThisDrawing.Utility.GetEntity returnObj, basePnt, "请选择一个对象"
    4 L+ M5 X! N- @) E0 b$ |2 h
53.     If Err <> 0 Then     '如果拾取点不在对象上会出错！
    
54.         Err.Clear
    6 n$ u0 C- h5 q
55.         MsgBox "结束程序", , "GetEntity 示例"
    
56.         Exit Sub
    3 Z1 k& R9 c9 |% c
57.     Else
    1 R6 |! Y  K) w7 l6 N8 b
58.         returnObj.Update     '刷新选择的对象
    1 s" v+ f% f6 N. q, O" O% l
59.         MsgBox "对象类型是: " & returnObj.EntityName, , "GetEntity 示例"      '返回图元名称，LINE的是ACDBLINE,circle是acdbcircle等等。
    
60.         MsgBox "对象类型是: " & returnObj.ObjectName, , "GetEntity 示例"      '返回值同上
    
61.         MsgBox "对象类型是: " & returnObj.ObjectID, , "GetEntity 示例"        '返回值一串数字
    
62.         MsgBox "对象类型是: " & returnObj.ObjectID32, , "GetEntity 示例"      '返回值两位数字
    
63.         MsgBox "对象类型是: " & returnObj.OwnerID, , "GetEntity 示例"         '返回值一串数字
    
64. '        returnObj.Update    '此句作用似乎不明显！
    5 _/ L9 A1 w  C7 \+ q+ m5 U% h# G, `
65.     End If
    
66.     GoTo RETRY
    
67. End Sub

复制代码

以上示例似乎没有感受到PickedPoint的效果！！

J、.GetInput方法

RetVal = GetInput()   结果是字符串，指定输入了哪个关键词的索引。

不怎么用，暂略。。。。。。

3 O7 X2 ?; o5 p& e; h% N0 k

kuangben8

K、.GetInteger方法

RetVal = GetInteger([Prompt])

Prompt：Variant[变体] (字符串); 仅用于输入;【可选项】提示用户输入的文本信息。

RetVal：Integer[整数]，用户返回的整数值。

AutoCAD 暂停，等待用户输入一个整数，将选择的值作为返回值。Prompt 参数指定了 AutoCAD 在暂停前显示的字串。Prompt 为可选项。

AutoCAD 用户可以输入任何有效的(短)整数，范围从 -32768 到 +32767 之间。

如果返回的不是整数而是关键词，或者是用户没有输入值直接按回车键，AutoCAD 则生成错误号-214530928（错误信息为“用户输入一个关键词”）。使用 GetInput 方法可以从返回值中获取关键词。

1. Sub GetInteger方法()
   6 w3 O% ?, X( q7 D2 x
2.     ' 此示例返回用户输入的整数。
   
3.     Dim returnInt As Integer
   
4.     ' 返回用户输入的值。提供提示。
   9 e9 z9 L$ {. @( j" \( z! v
5.     returnInt = ThisDrawing.Utility.GetInteger("请输入一个整数: ")
   ) m+ [% ]. b- Q# J
6.     MsgBox "输入的整数是 " & returnInt & vbCrLf & "(输入下一个值而不提示。)", , "GetInteger 示例"
   
7.     '返回用户输入的值。不提供提示。
   2 ^4 E' F# d3 Z5 y4 i8 ~
8.     returnInt = ThisDrawing.Utility.GetInteger()
   
9.     MsgBox "输入的整数是" & returnInt, , "GetInteger 示例"
   
10. End Sub

复制代码

; s% a$ _7 X/ v; [4 E' w

L、.GetKeyWord方法

RetVal = GetKeyword([Prompt])

Prompt: Variant[变体] (字符串); 仅用于输入;[可选项]用于提示用户输入的文本。

RetVal: 字符串,用户返回的关键词。

说明

AutoCAD 暂停,等待用户输入一个关键词，并将输入关键词的值设为返回值。Prompt 参数指定了在 AutoCAD 暂停之前显示的字串。Prompt 为可选项。返回值的最大长度为511个字符。

AutoCAD 用户可以通过键盘输入一个关键词。该方法接受的关键词列表是由事先调用 InitializeUserInput 方法来设置的。如果用户输入的字串没有在调用 InitializeUserInput 所指定的关键词中，AutoCAD 显示一个错误信息并重试（如果指定有提示，则重新显示提示）。如果用户没输入任何值只是按下回车键，GetKeyword 返回一个空字串("")，除非调用 InitializeUserInput 时不允许 NULL 输入。

1. Sub GetKeyword方法()
   
2.     '此示例使用GetKeyword返回用户输入的关键字。InitializeUserInput建立有效的关键字。
   
3.     ' 定义有效关键字列表
   5 m3 I: a; }3 @7 \: v1 |' D7 ?
4.     Dim kwordList As String
   ( B$ O# @4 T! O5 b4 S& ~
5.     kwordList = "Width Height Depth WWE High"
   
6.     ThisDrawing.Utility.InitializeUserInput 1, kwordList
   
7.     ' 提示用户输入的任何的两个关键词。返回“宽”、“高”或“深度”returnstring变量取决于是否在用户输入“W”，“H”或“D”。
   
8.     Dim returnString As String
   
9.     returnString = ThisDrawing.Utility.GetKeyword("输入一个关键字 (Height)(Width)(Depth)(WWE): ")
     B' z7 ~: f% ~% R; J6 ^
10.     '用户可以只输入首字符，然后自动识别，当有多个首字符相同时返回第一个对应首字符的字符串关键字
    
11.     MsgBox "你输入了" & returnString, , "GetKeyword 示例"
    ( l! W/ ^: C& V# [: Y
12. End Sub

复制代码

- B8 M/ b2 S2 b# G/ l3 {
+ ~# J2 `& j, C. z

kuangben8

M、.GetOrientation方法

RetVal = GetOrientation([Point][,Prompt])       获取指定角度。忽略ANGBASE 系统变量的设置。

Point: Variant[变体] (三元素双精度数组); 仅用于输入; [可选项]指定基点的三维 WCS 坐标。

Prompt: Variant[变体] (字符串); 仅用于输入;[可选项]提示用户输入的文本信息。

RetVal: Double[双精度],指定的角度。

说明

AutoCAD 暂停,等待用户输入一个角度，并将选择角度的值作为返回值。Point 参数指定角度在三维 WCS 中的基点。Prompt 参数指定 AutoCAD 在暂停前显示的字符串。Point 和 Prompt 都是可选项。

AutoCAD 用户可以通过输入一个以当前角度单位格式为单位的数值来确定一个角度。用户也可以通过在图形屏幕上指定两个二维位置来确定角度。AutoCAD 画一条橡皮筋线到当前十字光标位置以帮助用户认清角度。如果提供了 Point 参数，AutoCAD 用这个值作为两点的第一个点值。角度是在WCS坐标系中的XY平面测量的（本方法忽略点的Ｚ值）。角度的方向逆时针为增。

除了指定角度，GetOrientation还经常用来设置以弧度表示的值的返回值。

该方法与 GetAngle方法相似，但它忽略保存在 ANGBASE 系统变量中的当前的0角度的方向。0角度在 GetOrientation 中一般指向右：“东方”或“时针的三点”。

如果返回的是关键词而不是角度，AutoCAD将生成错误信息“用户输入关键词”。用 GetInput 方法可以从返回值中获得关键词。

1. Sub GetOrientation方法()
   
2.     '此示例使用getOrientation方法演示从用户检索方向的三种不同方法。
   / V  X* H& H2 z* X5 d
3.     Dim retOrientation As Double
   0 N6 ^! Z. w1 Q4 {6 Y+ V
4.     ' 返回以弧度表示的方向并提示
   
5.     retOrientation = ThisDrawing.Utility.GetOrientation(, "输入一个角度： ")    '输入90，结果返回的是π/2=1.57.....
     L$ j% M/ d5 F$ R! v$ C& s; b
6.     MsgBox "被输入的角度是" & retOrientation & vbCrLf & "(输入下一个值而不提示。)", , "GetOrientation 示例"
   
7.     ' 无提示返回弧度方向
   * ?- B& u9 Z' Z1 @3 c' C
8.     retOrientation = ThisDrawing.Utility.GetOrientation()
   ; V( M  d/ ?( I& c
9.     '也可以通过点选两个点来产生直线的角度，同样以起点为准逆时针旋转至终点的角度
   # Z* E/ |  p3 i$ L" c- n# x4 J
10.     MsgBox "被输入的角度是：" & retOrientation, , "GetOrientation 示例"
    / K0 p4 f0 b4 }/ r
11.     ' 返回带有提示和方向基点的以弧度表示的方向
    
12.     Dim basePnt(0 To 2) As Double
    $ j2 z/ V* j' O; m3 s8 P8 ?. r
13.     basePnt(0) = 2#: basePnt(1) = 2#: basePnt(2) = 0#
    3 H9 b) `1 I( ?0 A, K3 o
14.     retOrientation = ThisDrawing.Utility.GetOrientation(basePnt, "请输入一个角度: ")
    $ V: q: [- p+ w6 D* Z
15.     MsgBox "输入的角度是：" & retOrientation, , "GetOrientation 示例"
    
16. End Sub

复制代码

N、.GetPoint方法

RetVal = GetPoint([Point][, Prompt])

Point：Variant[变体] (三元素双精度数组); 仅用于输入; 【可选项】指定相对基点的三维 WCS 坐标。

Prompt：Variant[变体] (字符串); 仅用于输入; 【可选项】提示用户输入的文本信息。

RetVal：Variant[变体] (三元素双精度数组)AutoCAD 用户选择的点的三维 WCS 坐标。

说明

AutoCAD 暂停，等待用户输入一个点，将选择点的坐标值设为返回值。Point 参数指定的在WCS中的相对基点。Prompt 参数指定了AutoCAD在暂停前显示的字串。Point 和 Prompt 都是可选项。

AutoCAD 用户可以通过输入一个当前单位格式的坐标点来指定一个点；GetPoint 将 Point 参数及返回值作为三维点。用户也可以通过在图形屏幕上指定一个位置来确定一个点。如果提供了 Point 参数，AutoCAD 将从该点到当前十字光标处画一条橡皮筋线。存储在返回值中的点坐标根据 WCS 来表示。

如果返回一个关键字而不是点，AutoCAD 将生成错误信息“用户输入关键词”。用 GetInput 方法可以获得返回值中的关键字。

1. Sub GetPoint方法()
   ) @  @: c4 j$ k2 I' q3 Q
2.     ' 此示例返回用户输入的点的坐标。
   
3.     Dim returnPnt As Variant
   7 X0 U- j. X' X% h4 V' j0 y
4.     ' 使用提示返回点
   . L" C3 w2 }7 [  y/ h
5.     returnPnt = ThisDrawing.Utility.GetPoint(, "选择/输入一个点: ")
   ! p8 D, \$ o& _; E) d
6.     MsgBox "WCS点坐标是: " & returnPnt(0) & ", " & returnPnt(1) & ", " & returnPnt(2) & vbCrLf & _
   
7.             "(不带提示的输入下一个点.)", , "GetPoint 示例"
   5 U/ z* p1 ], ~3 f" Z8 K: q2 i
8.     ' 不带提示的输入下一个点
   : D* g6 r% w) O! q5 Q2 j9 R
9.     returnPnt = ThisDrawing.Utility.GetPoint
   
10.     MsgBox "WCS点的坐标是: " & returnPnt(0) & ", " & returnPnt(1) & ", " & returnPnt(2), , "GetPoint 示例"
    
11.     ' 使用基点和提示返回点
    1 g( H1 |4 `% `, t2 E# i
12.     Dim basePnt(0 To 2) As Double
    ( ?0 k; e5 P# R1 ~$ j( C
13.     basePnt(0) = 2#: basePnt(1) = 2#: basePnt(2) = 0#
    ' j' t2 g; @& @# V% }' {
14.     returnPnt = ThisDrawing.Utility.GetPoint(basePnt, "Enter a point: ")
    ; N( v5 x1 l- y
15.     MsgBox "WCS点的坐标是: " & returnPnt(0) & ", " & returnPnt(1) & ", " & returnPnt(2)
    
16.     ' 从基点和输入的最后一个点创建一条线
    
17.     Dim lineObj As AcadLine
    . V& M  ~( a1 L) R1 g
18.     Set lineObj = ThisDrawing.ModelSpace.AddLine(basePnt, returnPnt)
    . W: i; e& K8 S* ]9 R2 u1 Y
19.     Update
    
20. End Sub

复制代码

此示例中并没有显示出基点的作用啊！。。。。。。。。。。。
- g; c4 N# N& k+ n3 N% ^3 w8 q2 l

kuangben8

O、.GetReal方法

RetVal = GetReal([Prompt])

Prompt：Variant[变体] (字符串); 仅用于输入; 【可选项】用来提示用户输入的文本信息。

RetVal：Double[双精度] 用户返回的值。

说明

AutoCAD 暂停，等待用户输入一个实数值，并将用户输入的值设为返回值。Prompt 参数指定 AutoCAD 在暂停前显示的字串，它是可选项。

如果返回的是关键字，而不是实数。AutoCAD 将生成错误信息“用户输入关键词”。用 GetInput 方法可以从返回值中获得关键字。

1. Sub GetReal方法()
   
2.     ' 此示例从用户处获取一个实数值
   
3.     Dim returnReal As Double
   
4.     ' 返回用户输入的值。提供提示.
   
5.     returnReal = ThisDrawing.Utility.GetReal("请输入一个实数值: ")
   
6.     MsgBox "输入的实数值是" & returnReal & vbCrLf & _
   
7.             "(不带提示的输入下一个实数值.)", , "GetReal 示例"
   % P1 z- R! R6 a2 j( a
8.     ' 不带提示的输入下一个值
   
9.     returnReal = ThisDrawing.Utility.GetReal()
   . L3 B; G$ n% ~1 ?) m- B
10.     MsgBox "输入的实数值是：" & returnReal, , "GetReal 示例"
    & o, s4 e* d# g8 W
11. End Sub

复制代码

, b5 }) b, o% R

, u% Y7 T+ t2 V- C: f

P、. GetRemoteFile方法

object.GetRemoteFile URL, LocalFile,IgnoreCache

URL：String[字符串]; 仅用于输入，需下载的文件的URL。

LocalFile：String[字符串]; 仅用于输出，在指定URL上的文件。

lgnoreCache：Boolean[布尔值]

TRUE: 即使文件已经在进程中传输也进行下载。

FALSE: 如果文件已经在进程中传输则不进行下载。

示例暂无！

Q、.GetString方法

RetVal = GetString(HasSpaces[, Prompt])

HasSpaces：Integer[整数]; 仅用于输入

TRUE: 返回的字符串可以包含空格。它只能以回车键为结束。

FALSE: 返回的字符串不可以包含空格。它可以以回车键或空格为结束。

Prompt：Variant[变体] (字符串); 仅用于输入; 【可选项】提示用户输入的文本信息。

RetVal：字符串，用户返回的字符串。

说明

AutoCAD 暂停，等待用户输入一个字符串，并将用户输入的值设为返回值。HasSpaces 参数指定了字符串是否可以包含空格。Prompt 参数指定了该方法在 AutoCAD 暂停前显示的字符串。

AutoCAD 用户可以通过键盘输入字符串。如果 HasSpaces 参数是TRUE，字符串中可以包含空格，用户必须按回车结束。如果 HasSpaces 参数是False，输入空格或回车都可以结束字符串的输入。如果用户输入多于132个字符，字符串的输入仍可继续直到用户输入一个空格或回车键（根据 HasSpacesd 而定），但是 GetString 只将前132个字符作为返回值。

1. Sub GetString方法()
   
2.     ' 这个例子演示了返回用户输入的字符串的不同方法。
   7 W) B8 v. b# Y2 V. S# y( v
3.     Dim returnString As String
   3 |# b3 ], S- X
4.     '提示输入，不能包含空格
   
5.     returnString = ThisDrawing.Utility.GetString(False, "输入文本（空格或<enter>终止输入）: ")
   8 W( e5 r9 d2 P. L' z9 Q( \
6.     MsgBox "输入的文本是：'" & returnString & "'", , "GetString 示例"
   
7.     ' 提示输入，可以包含空格
   
8.     returnString = ThisDrawing.Utility.GetString(True, "输入文本（按<enter>终止输入）:")
   
9.     MsgBox "输入的文本是：'" & returnString & "'", , "GetString 示例"
   ) o' }' h- l& g" i3 I2 x; N
10.     ' 提示和输入可以包含空格，但不能包含空字符串
    
11.     Dim NoNull As Integer
    
12.     NoNull = 1    '不允许不输入字符
    + X( v# d6 \- |; C
13.     ThisDrawing.Utility.InitializeUserInput NoNull
    
14.     returnString = ThisDrawing.Utility.GetString(True, "输入文本（按<enter>终止输入）: ")
    
15.     MsgBox "输入的文本是：'" & returnString & "'", , "GetString 示例"
    
16. End Sub

复制代码

! k( ]9 t  ~" T5 e. b8 U& z6 m

kuangben8

R、.GetSubEntity方法

object.GetSubEntity Object, PickedPoint, TransMatrix,ContextData[, Prompt] 以交互方式获取对象或子图元。

Object：Object[对象]; 仅用于输出，被选取的对象或子图元。可以是任何一个图形对象。

PickedPoint：Variant[变体] (三元素双精度数组); 仅用于输出，选取点的三维 WCS 坐标。

TransMatrix：Variant[变体] (4x4 双精度数组); 仅用于输出，该图元的转换矩阵。

ContextData：Variant[变体] (长整数数组); 仅用于输出，被选取对象中所有嵌套对象的对象ID的数组。

Prompt：Variant[变体] (字符串); 仅用于输入; 【可选项】提示用户输入的文本信息。

说明

该方法需要 AutoCAD用户通过在图形屏幕上拾取一个点来选择一个对象。如果一个对象或子图元被选中，它将在第一个参数中返回，第二个参数将包含拾取点的 WCS 坐标值。如果拾取点处没有对象，则该方法失败。该方法甚至可以获取在屏幕上不可见或它在冻结层里的对象。

1. Sub Example_GetSubEntity()
   , b; C2 d6 a; O: r  @. ~2 A; e
2.     '此示例提示用户单击鼠标选择屏幕上的对象，并返回有关所选对象的一些信息。
   
3.     Dim Object As Object
   5 J$ `4 w! O" Q* C' S2 X+ f
4.     Dim PickedPoint As Variant, TransMatrix As Variant, ContextData As Variant
   0 J: o' R5 J; P5 a
5.     Dim HasContextData As String
   6 A! _) _8 G; [7 u- P! E
6.     On Error GoTo NOT_ENTITY
   
7. TRYAGAIN:
   
8.     MsgBox "取消此对话框后，使用鼠标单击当前图形中的对象。"
   
9.     '获取所选对象的信息
   : `# `+ `' q# K+ E7 U+ x+ p9 r
10.     ThisDrawing.Utility.GetSubEntity Object, PickedPoint, TransMatrix, ContextData
    ) }( H2 p, m7 q3 a/ v, ]
11.     ' 处理和显示所选对象属性
    4 m! R& q: W' E6 O' b
12.     HasContextData = IIf(VarType(ContextData) = vbEmpty, " 不包含 ", " 包含 ")
    
13.     MsgBox "你选择的对象是: " & TypeName(Object) & vbCrLf & _
    
14.         "你选择的点坐标是: " & PickedPoint(0) & ", " & _
    8 }+ F* P/ Y7 x; S
15.         PickedPoint(1) & ", " & _
    
16.         PickedPoint(2) & vbCrLf & _
    
17.         "所选对象" & HasContextData & "有嵌套对象."
    
18.     Exit Sub
    
19. NOT_ENTITY:
    
20.     '如果单击空白空间或不选择实体，将生成此错误
    ( ^: @5 J! R: P) L3 K
21.     If MsgBox("你未选择对象实体.  单击“确定”重试.", _
    + ^5 H' l" @2 C
22.         vbOKCancel & vbInformation) = vbOK Then
    
23.         Resume TRYAGAIN
    : C9 o5 @; [: q) ?9 O  M( h9 K
24.     End If
    ! e7 z! Q9 G  Z* |, v; I
25. End Sub

复制代码

2 w; v# t4 X- H

; Y1 D1 [/ E3 x) @) T

S、.InitalizeUserInput方法

object.InitializeUserInput Bits[, Keyword]      初始化 GetKeyword 方法。

Bits：Integer[整数]; 仅用于输入

要同时设置多个条件上，可把这些值相加做任意组合如果不包含这些值或设为 0，则不使用这些控制条件。

1 ：不接受 NULL 输入。防止用户只按回车或空格来响应输入请求。

2：不接受输入零值(0)。防止用户输入 0 来响应输入请求。

4：不接受输入负值。防止用户输入负值来响应输入请求。

8：即使 LIMCHECK 系统变量为打开时也不检查图形界限。使用户能够输入当前图形界限以外的点。即使 AutoCAD 的系统变量 LIMCHECK 当前被设置为开 (ON)，本条件也照样对随后调用的用户输入函数有效。

16：目前不使用。

32：用虚线绘制拖引线或拉伸方框。对于那些可以由用户在图形屏幕上通过选择位置来指定一个点的函数，设置该控制位将使拖引线和拉伸方框显示为虚线而不是实线（某些显示驱动程序用颜色醒目的线来代替虚线）。如果系统变量 POPUPS 设为 0，AutoCAD 将忽略该控制位。

64：忽略三维点的 Z 坐标(只用于GetDistance 方法). 该项忽略由 GetDistance 方法返回的三维点的 Z 坐标，以使应用程序确保该函数返回的是二维距离。

128：允许任意输入任何用户类型。

KeyWord：Variant[变体] (字符串数组); 仅用于输入; 【可选项】将被后续的用户输入方法识别的关键字。

说明

在调用GetKeyword 前必须用该方法定义关键字。假如已经调用该方法定义了关键字，请确定用户输入方法可接受正常返回值以外的关键字值。可接受关键字的用户输入方法有：GetKeyword, GetInteger, GetReal, GetDistance, GetAngle,GetOrientation, GetPoint, 和 GetCorner。

示例暂略！

T、.IsRemoteFile方法

RetVal = object.IsRemoteFile(LocalFile,URL)

LocalFile：String[字符串]; 仅用于输入下载的文件。

URL：String[字符串]; 仅用于输出下载的文件的URL (如果有)。

RetVal：Boolean[布尔值]

TRUE: 文件从远程位置下载。

FALSE: 文件不从远程位置下载。

说明

该方法与 IsURL 方法相反，它提供了从本地文件到下载的文件所对应的 URL 映射。

示例暂略！

kuangben8

U、.IsURL方法

RetVal = object.IsURL(URL)

URL: String[字符串]; 仅用于输入所要验证的URL。

RetVal：Boolean[布尔值]

TRUE: 字符串为有效的 URL。

FALSE: 字符串为无效的 URL。

说明

“无效”的 URL 定义与应用程序有关，在这里给定的第三方应用程序可能对支持所有 Internet 协议不感兴趣。例如，一个应用程序试图连接用户到网站而不需要提供访问到 FTP 站点。在这种假定的应用程序中，如果 URL 不是以“http://”开头，将返回 FALSE。

该方法默认的功能支持 FTP、HTTP、HTTPS和 FILE 协议。

示例暂略！

V、.LaunchBrowserDialog方法

启动 Web 浏览器窗口，允许用户导航到任意 URL 并可指定 URL。暂略！

W、.PolarPoint方法

RetVal = PolarPoint(Point, Angle, Distance)   获取与给定点指定角度和距离的点坐标。

Point：Variant[变体] (三元素双精度数组); 仅用于输入指定起点的三维WCS坐标。

Angle：Double[双精度]; 仅用于输入以弧度为单位的角度值。

Distance：Double[双精度]; 仅用于输入以当前单位为单位的距离值。

RetVal：Variant[变体] (三元素双精度数组)该三维WCS的坐标是根据相对给出点的距离和角度得到的坐标。

1. Sub PolarPoint方法()
   
2. '此示例查找与基点之间给定距离和角度的点的坐标。
   
3.     Dim polarPnt As Variant
   
4.     Dim basePnt(0 To 2) As Double
   
5.     Dim angle As Double
   
6.     Dim distance As Double
   
7.     basePnt(0) = 2#: basePnt(1) = 2#: basePnt(2) = 0#
   
8.     angle = 3.1415926 / 2 ' 90 degrees
   6 y5 ^: z& P2 ]# J' s
9.     distance = 5
   : X8 C1 ~% j5 Y& Y, v. Y# |: o+ F
10.     polarPnt = ThisDrawing.Utility.PolarPoint(basePnt, angle, distance)
    
11.     ' 从基点到选择点之间画一条直线
    
12.     Dim lineObj As AcadLine
    
13.     Set lineObj = ThisDrawing.ModelSpace.AddLine(basePnt, polarPnt)
    1 w. U: ^4 {& D, v" {  A' n( k. t& F/ y
14.     ZoomAll
    4 Z, ^( Q8 ~1 g! L. V' b9 G
15. End Sub

复制代码

# O# M9 Q- a* A6 U. n

X、.Prompt方法

object.Prompt Message

Message：String[字符串]; 仅用于输入要显示的提示内容。

Sub Example_Prompt()

'此示例将使用实用程序对象向AutoCAD命令行显示提示。要在运行示例后查看结果，请切换到AutoCAD并查看命令行。

   ThisDrawing.Utility.Prompt "L 0,0 100,100  "   '只是在命令行显示字符串，并不能发送命令绘图！

End Sub

Y、.PutRemoteFile方法

object.PutRemoteFile URL, LocalFile

URL：String[字符串]; 仅用于输入指定要上传文件的 URL 位置。

LocalFile：String[字符串]; 仅用于输入要上传的文件。

说明

该方法是为了完善GetRemoteFile 方法来设计的。

当连接到一个安全的URL后，会弹出一个对话框提示用户输入必要的密码信息。如果用户没有在其浏览器中抑制该行为，则会出现消息框。

示例暂略！
) v2 i9 ]0 {  Z7 x0 `2 V& E5 h

kuangben8

# R4 l" j& N8 M. Z  F7 bZ、.RealToString方法

RetVal = RealToString(Value, Unit,Precision)

Value：Double[双精度]; 仅用于输入要转换的值。

Unit：AcUnits 常数; 仅用于输入

acDefaultUnits  默认格式

acScientific     科学计数法格式

acDecimal      十进制格式

acEngineering   工程格式

acArchitectural  建筑格式

acFractional    分数格式

Precision：Integer[整数]; 仅用于输入值的精度。为 0 到 8 的整数

RetVal：字符串，相应格式的字符串值。

1. Sub RealToString方法()
   8 k7 _5 G0 l1 d2 V2 V+ Y8 x
2.     ' 此示例将给定格式的值转换为等效的字符串。
   
3.     Dim unit As Long
   ! h/ B- o. c8 @2 ^6 t4 k$ L* P! F. E. |
4.     Dim valueAsStr As String
   
5.     Dim precision As Integer
   
6.     Dim valueAsReal As Double
   ' i2 p- s. R, ^$ }
7.     precision = 6
   
8.     '使用科学模式将实值17.5转换为字符串
   
9.     unit = acScientific
   
10.     valueAsStr = ThisDrawing.Utility.RealToString(17.5, unit, precision)
    
11.     MsgBox "17.5科学格式为" & valueAsStr, , "RealToString 示例"
    2 P1 I4 D6 I2 Q7 E: Z
12.     ' 使用十进制模式将实值17.5转换为字符串
    / W, [. q7 e' Z) {% v  v5 b: }
13.     unit = acDecimal
    
14.     valueAsStr = ThisDrawing.Utility.RealToString(17.5, unit, precision)
    ; W/ G5 E0 u. p) \  F
15.     MsgBox "17.5十进制格式为" & valueAsStr, , "RealToString 示例"
    * r( L' ~! j) o0 h, ]& B2 P
16.     ' 使用工程模式将实值17.5转换为字符串
    1 t6 b8 t, Q. s2 D7 W
17.     unit = acEngineering
    6 |0 y" o; j% S: Q% Y
18.     valueAsStr = ThisDrawing.Utility.RealToString(17.5, unit, precision)
    
19.     MsgBox "17.5工程格式为" & valueAsStr, , "RealToString 示例"
    " S+ X! S# [+ N! e- `1 w! f
20.     ' 使用体系结构模式将实值17.5转换为字符串
    8 [' g2 x) T+ u' o. s3 ^
21.     unit = acArchitectural
    1 K  u& F# W' X' D  I7 |& ~4 V
22.     valueAsStr = ThisDrawing.Utility.RealToString(17.5, unit, precision)
    
23.     MsgBox "17.5建筑形式为" & valueAsStr, , "RealToString 示例"
    4 B3 q- p5 S( k# z
24.     ' 使用分数模式将实值17.5转换为字符串
    
25.     unit = acFractional
    
26.     valueAsStr = ThisDrawing.Utility.RealToString(17.5, unit, precision)
    
27.     MsgBox "17.5分数格式为" & valueAsStr, , "RealToString 示例"
    5 W3 {% Z: q; l: Y5 W) h9 i6 U
28. End Sub

复制代码

  e( ^: l1 }4 ^
AA、.SendModelessOperationEnded方法

object.SendModelessOperationEnded(Context)

AB、.SendModelessOperationStart方法

object.SendModelessOperationStart(Context)

AC、.TranslateCoordinates方法

RetVal =object.TranslateCoordinates(OriginalPoint, From, To, Disp[, OCSNormal])  将点从一个坐标系转换到另一个坐标系。

OriginalPoint ：Variant[变体] (三元素双精度数组); 仅用于输入指定要转换的源坐标的三维 WCS 坐标。该参数可被看为一个点或相对于 Disp 值的位移矢量。

From：AcCoordinateSystem 常数; 仅用于输入点的源坐标系，有如下参数。

acWorld          acUCS         acOCS         acDisplayDCS       acPaperSpaceDCS

To：AcCoordinateSystem 常数; 仅用于输入点将被转换到的坐标系。

acWorld         acUCS         acOCS         acDisplayDCS        acPaperSpaceDCS

Disp：Integer[整数]; 仅用于输入位移矢量标记

TRUE: OriginalPoint 作为位移矢量。 FALSE: OriginalPoint 作为一个点。

OCSNormal：Variant[变体] (三元素双精度数组); 仅用于输入;可选项OCS 的法线。

RetVal：Variant[变体] (三元素双精度数组)转化后的三维坐标。

说明

用户不能直接将坐标从一个OCS 转换到另一个 OCS。首先将一个坐标从一个 OCS 转换为中间坐标系(如 WCS)，然后将其坐标转换为第二个 OCS 。

将 Polyline 或 LightWeightPolyline 上的点从 OCS 转换到 WCS：

1. 从 Coordinate 或 Coordinates属性中获得 OCS 点的 X 和 Y 坐标。

2. 通过 Elevation 属性获得 OCS 点的 Z 坐标。

3. 从 Normal 属性中获得样条曲线的法线。

4. 用 X, Y, Z 坐标及 Normal 调用TranslateCoordinates 。

示例暂略！
3 G. s9 R$ p% W- a关于Utility对象及其方法示例下载：
2.12、很有用的Utility对象.zip (19.21 KB, 下载次数: 7)

2019-3-29 20:58 上传

点击文件名下载附件

kuangben8

13、使用Utility对象手动辅助绘图示例
$ q) @) b' c( E" w: `7 T, h# z) {, E
A、手动三点画弧

1. Sub 手动三点画弧1()
   
2.     Dim P1 As Variant, P2 As Variant, P3 As Variant, L1 As AcadLine, L2 As AcadLine
   
3.     With ThisDrawing
   # U2 W2 n- @: R. C) B& d
4.         With .Utility
   5 |. w2 B% m- R- [& X3 s% F
5.             P1 = .GetPoint
   
6.             P2 = .GetPoint
   
7.             P3 = .GetPoint
   4 d7 l  F$ W- L% h0 j
8.         End With
   
9.         Set L1 = .ModelSpace.AddLine(P1, P2)
   
10.         Update
    
11.         Set L2 = .ModelSpace.AddLine(P2, P3)
    
12.         Update
    
13.         L1.StartPoint = .Utility.PolarPoint(L1.StartPoint, L1.Angle, L1.Length / 2)   '将L1起点坐标修改为L1中点坐标
    $ Y2 C! k. O( h* B
14.         Update
    
15.         L1.Rotate L1.StartPoint, .Utility.AngleToReal(90, acDegrees)                  'L1绕新起点旋转90°(将90转换为弧度)
    / |/ ?+ M. k  ^: G. _6 }
16.         Update
    # m4 C! O; h9 o2 S7 z+ N  U
17.         L2.StartPoint = .Utility.PolarPoint(L2.StartPoint, L2.Angle, L2.Length / 2)   '将L2起点坐标修改为L2中点坐标
    : T: B# ]& s9 z, q3 s( C: T
18.         Update
    
19.         L2.Rotate L2.StartPoint, .Utility.AngleToReal(90, acDegrees)                  '同样将L2绕新起点旋转90°
    ! p! t9 c' q" d8 p8 [5 a6 q
20.         Update
    
21.         L1.StartPoint = L1.IntersectWith(L2, acExtendBoth)      '将L1起点修改为L1和L2相交的交点坐标(双方都延伸)，也就是圆心。
    3 d5 i9 o, L4 O* B* L
22.         Update
    
23.         L1.EndPoint = P1
    
24.         Update
    
25.         L2.StartPoint = L1.StartPoint     'L2的起点坐标修改为L1的起点坐标,也就是圆心处。
    
26.         Update
    : `3 P- ^" k1 u; l
27.         L2.EndPoint = P3
    6 z  Q# E6 \# u( K) N, f9 b/ ^
28.         Update
    ! z* p9 T* @: y- N, {
29.         .ModelSpace.AddArc L1.StartPoint, L1.Length, L1.Angle, L2.Angle
    0 u7 c1 ^0 ~9 d
30.         Update
    9 h3 L1 h9 @8 |% e2 @
31.         .ModelSpace.AddArc L1.StartPoint, L1.Length, L2.Angle, L1.Angle
    . P+ q8 ^% z& P, e$ U& y3 I1 H
32.         Update
    # w# ^" y: M: J
33.         L1.Delete
    ) Q' r2 k% x2 m/ p( U+ i
34.         Update
    + n9 R; f( S( ^* y% O% A: O7 P
35.         L2.Delete
    " J) Y. W: V3 g1 P9 L
36.         Update
    5 \, r6 w  q* ?+ D* i4 m9 R
37.     End With
    8 B( Z4 I  N+ T0 b/ a2 p
38. End Sub

复制代码

8 _/ R+ z2 ]6 `; w

B、手动三点画圆

类似手动三点画弧,因此没有想到其他解法时暂略重复代码!

' t; Z. q: A. c* r6 X2 W* B$ x

C、手动两点半径画弧

1. Sub 手动两点半径画弧()
   
2.     Dim P1 As Variant, P2 As Variant, R As Double, L As AcadLine, ARC As AcadArc
   8 O( D% C0 Y6 S# [+ {( _
3.     With ThisDrawing
   
4. X:
   
5.         With .Utility
   3 f0 u: N8 O1 ]3 p
6.             P1 = .GetPoint
   
7.             P2 = .GetPoint
   
8.             R = .GetReal("请输入圆弧半径(Double类型)")
   , ~$ s: h+ b7 V/ U) x
9.         End With
   : s3 w! B% Y8 r6 r2 d, i
10.         Set L = .ModelSpace.AddLine(P1, P2)
    
11.         Update
    , ?+ c9 B6 {  b; m3 O0 u, K0 M
12.         Dim FirstAngle As Double, EndAngle As Double
    3 B! e" {( {+ ]9 d) g
13.         If L.Length > 2 * R Then
    1 Z4 ]" b6 J5 |9 w) n
14.             If MsgBox("输入的两点距离大于半径的2倍，无法画弧，请重新输入！", vbYesNo + vbInformation, "AutoCAD友情提示") = vbYes Then
    
15.                 GoTo X
    
16.             Else
    
17.                 Exit Sub
    % |5 x$ M9 ^! d$ k3 l8 f. \
18.             End If
    
19.         ElseIf L.Length = 2 * R Then
    4 `+ V, G8 L; _8 |( I+ d5 ]
20.             Dim P0 As Variant
    
21.             With .Utility
      Q( W+ `* ]) C- E4 ~1 o8 y% D
22.                 P0 = .PolarPoint(P1, L.Angle, L.Length / 2)     '获取圆心坐标
    2 m. `9 v( a; C
23.                 FirstAngle = .AngleFromXAxis(P0, P1)            '获取起始角弧度
    
24.                 EndAngle = .AngleFromXAxis(P0, P2)              '获取终止角弧度
    
25.             End With
    
26.             Set ARC = .ModelSpace.AddArc(P0, R, FirstAngle, EndAngle)
    
27.             Update
    % N, T& V  s; H& g# Z9 U5 A+ t
28.         Else
    
29.             Dim P01(2) As Double, P02(2) As Double, cir1 As AcadCircle, cir2 As AcadCircle
    + S8 r7 u+ t. w$ R# ?8 P
30.             Set cir1 = .ModelSpace.AddCircle(P1, R)
    + y! f. u$ H5 F2 f* N  n
31.             Set cir2 = .ModelSpace.AddCircle(P2, R)
    
32.             P01(0) = cir1.IntersectWith(cir2, acExtendNone)(0)      '第一个圆心坐标
    
33.             P01(1) = cir1.IntersectWith(cir2, acExtendNone)(1)
    . o  K. e; m! `0 g7 a
34.             P02(0) = cir1.IntersectWith(cir2, acExtendNone)(3)      '第二个圆心坐标
    9 T! w4 |! ^" Q; d/ F6 E) y; c" m
35.             P02(1) = cir1.IntersectWith(cir2, acExtendNone)(4)
    : x. r) k- I9 x/ ~+ D$ X# d, l
36.             With .Utility
    
37.                 FirstAngle = .AngleFromXAxis(P01, P1)
    
38.                 EndAngle = .AngleFromXAxis(P01, P2)
    
39.             End With
    
40.             Set ARC = .ModelSpace.AddArc(P01, R, FirstAngle, EndAngle)
    
41.             Update
    
42.             
    % z) h* [) ?/ I2 U
43.             With .Utility
    
44.                 FirstAngle = .AngleFromXAxis(P02, P1)
    ! e/ }& X! Z1 V( T$ P! S5 v2 f
45.                 EndAngle = .AngleFromXAxis(P02, P2)
    & y, `2 U7 e, Z6 w3 p1 r& V
46.             End With
    
47.             Set ARC = .ModelSpace.AddArc(P02, R, FirstAngle, EndAngle)
    
48.             Update
    
49.         End If
    " \1 {8 W: `4 O, C6 p/ A' f& P
50.         cir1.Delete
    
51.         cir2.Delete
    
52.     End With
    0 T2 b2 M3 E+ x$ Y2 y9 W
53. End Sub
    ( V# r4 [* I6 X: ?+ h& j2 i

复制代码

2.13、利用Utility对象方法画图.zip (7.87 KB, 下载次数: 7)

2019-3-29 21:02 上传

点击文件名下载附件



1 L3 A- N$ C* ^& R$ V

kuangben8

14、手动取点画图时添加提示线

4 e# J/ {: |% I. l7 Y6 C

想要在绘图时根据手动取点后,在上一点和下一点之间显示一条弹性线并有提示,在使用Utility对象的相关方法时,参数中的基点坐标不可省略！含有Prompt的方法均写上即可。

A、手动画一条直线

1. Sub 画直线()
   
2.     Dim P1 As Variant, P2 As Variant, L As AcadLine
   
3.     With ThisDrawing
   
4.         With .Utility
   % b2 N$ E; S/ `0 a' R: e4 b
5.             P1 = .GetPoint(, "请选择第一个点的位置")
   3 B  E. R7 d/ S  _7 ~  J5 P
6.             P2 = .GetPoint(P1, "请选择第二个点的位置")    '在第一个点和鼠标之间会有一个随鼠标移动的弹性线
   
7.         End With
   
8.         Set L = .ModelSpace.AddLine(P1, P2)
   . f* K+ d: I1 f# i" c
9.     End With
   ; K3 ]# A% S: w% R9 N
10. End Sub

复制代码

B、手动画圆

1. Sub 画圆()
   
2.     Dim P0 As Variant, R As Double, cir As AcadCircle
   
3.     With ThisDrawing
   ! U1 u7 ~. }, ^# Q, y, ]3 t; {
4.         With .Utility
   
5.             P0 = .GetPoint(, "请选择圆心所在位置")
   ) P  c2 j2 U3 O8 v) u) X
6.             R = .GetDistance(P0, "请输入圆的半径")  '以P0为基点，可以输入距离或者点击下一点
   ! l+ \' a) R' }3 g# e
7.         End With
   
8.         Set cir = .ModelSpace.AddCircle(P0, R)
   
9.         '以上写法只能实现在屏幕上出现提示信息和提示线，不会产生随鼠标动的圆
   . j+ ]" r+ {0 l- O2 j5 M6 q4 S2 c' G
10.         Set cir = .ModelSpace.AddCircle(P0, .Utility.GetDistance(P0, "请输入圆的半径"))
    8 H$ M; @- @6 _7 C8 j" k
11.         '同上，似乎不能产生随鼠标动的圆，需要用到LISP语言才有这个效果！
    
12.     End With
    . z6 V, ^/ O  Y& m
13. End Sub

复制代码

- F3 {8 p2 I* B4 K4 ]! u; X1 R5 G

想要产生如同图形界面画图那样的生动效果,还是需要采用LISP语言比较合适.

2.14、手动绘图时添加提示信息及提示线.zip (5.56 KB, 下载次数: 8)

2019-3-29 21:05 上传

点击文件名下载附件

; ?' O* K9 [- X% `5 N# K* |  q

kuangben8

5 ?/ K/ A) r/ k1 q5 |15、样条曲线对象(SpLine)

A、添加样条曲线方法(AddSpline)

RetVal = object.AddSpline(PointsArray,StartTangent, EndTangent)

PointsArray: Variant[变体] (双精度数组); 用于输入定义样条曲线的三维WCS坐标数组。至少需要两个点(六个元素)来构成 Spline 对象。并且样条曲线始终以该数组的每三个元素为一个点的坐标,因此该数组大小必须为3的倍数。若不指定元素值,默认坐标均为0。

StartTangent: Variant[变体] (三元素双精度数组); 用于指定与样条曲线第一点相切的三维坐标。

EndTangent: Variant[变体] (三元素双精度数组); 用于指定与样条曲线最后一点相切的三维坐标。

关于此二参数的说明: 一组三维坐标代表一个点，与第一个点或最后一个点组成的直线方向就是对应起点或终点的切线方向;以起点或终点为直线的起点，水平向右为X轴，逆时针旋转至三维坐标点所在处的角度就是切向角。如果三维参数都是0，就是不指定方向（用CAD的默认方向）。

RetVal:新创建的样条曲线对象。

1. Sub AddSpline方法()
   
2.     ' 该示例在模型空间中创建样条曲线对象。
   , a: O' `* }5 `8 C& {
3.     Dim splineObj As AcadSpline
   ) o, \, n( N, d8 g1 ^0 v/ X
4.     Dim startTan(0 To 2) As Double
   
5.     Dim endTan(0 To 2) As Double
   ' {, V; D2 x7 ], C4 [1 ]
6.     Dim fitPoints(0 To 8) As Double
   
7.     startTan(0) = 0.5: startTan(1) = 0.5: startTan(2) = 0     ‘第一个点的切向点坐标
   
8.     endTan(0) = 0.5: endTan(1) = 0.5: endTan(2) = 0       ‘最后一个点的切向点坐标
   
9.     fitPoints(0) = 1: fitPoints(1) = 1: fitPoints(2) = 0
   * T6 b% l7 `3 I9 a0 h, _/ G0 s! U
10.     fitPoints(3) = 5: fitPoints(4) = 5: fitPoints(5) = 0
    
11.     fitPoints(6) = 10: fitPoints(7) = 0: fitPoints(8) = 0
    5 d/ g1 ~' K; N$ C- j
12.     Set splineObj = ThisDrawing.ModelSpace.AddSpline(fitPoints, startTan, endTan)
    3 e3 V, @- c9 g" q+ @  t
13.     Update
    ; a* [  D2 B; F; H8 X8 Y+ i
14. End Sub
      s3 y0 ^' N: W; K, c: Y6 r' i$ i/ i

复制代码

: T5 k8 L' a/ c% EB、样条曲线对象(SpLine)的常用方法及属性

常用方法:

Copy、Delete、IntersectWith、Mirror、Move、Offset、Rotate、Update……具体示例略,参考一下Reverse、Offset示例，体会一下Offset的结果是多条样条曲线的情况。

* E: {; x% q) W; J

1. Sub 样条曲线的常用方法()
   
2.     Dim P(299) As Double, SP As AcadSpline
   
3.     Dim startTan(0 To 2) As Double
   2 K2 F: s8 t  N  ~0 D, J
4.     Dim endTan(0 To 2) As Double
   4 w7 _2 M! f  Q2 i# ^, @8 r! M% _5 b
5.     Dim M%
   5 r2 l3 n4 r8 i  b# I$ ]+ Z
6.     Const π As Double = 3.14159265358979
   
7.     For M = 1 To 100
   
8.         P(3 * M - 3) = M * 0.1
   3 @5 q) S/ Z% e; U! J/ x
9.         P(3 * M - 2) = Sin(M * π / 10)
   
10.         P(3 * M - 1) = 0
    5 h6 _5 b; M* j" X9 g
11.     Next
    
12.     startTan(0) = 0: startTan(1) = 0: startTan(2) = 0
    
13.     endTan(0) = 0: endTan(1) = 0: endTan(2) = 0
    6 L9 O. X: M+ q7 [7 b3 \
14.     Set SP = ThisDrawing.ModelSpace.AddSpline(P, startTan, endTan)
    3 p9 U- T6 _* Z# v& l% h$ Z
15.     Update
    * [3 K/ P2 m& D: M* c4 B
16.     Rem 接下来参考反转和偏移示例，其他示例略！
    & }& D$ T* G+ K! H
17.     Dim pll As AcadSpline, SPL As Variant
    
18.     Set pll = SP.Copy
    
19.     Update
    
20.     pll.Reverse     '反转样条曲线的方向：就是将原来的第一点变成最后一点，最后一点变成第一点。
    
21.     Update
    
22.     SPL = SP.Offset(-0.5)   '正值向下偏移，负值向上偏移
    2 A% O1 I) g$ o8 K
23.     Update
    
24.     SPL(0).color = acCyan  '发现偏移后的结果不在是一条样条曲线，而是多条样条曲线
    , c- Q5 M  T6 U& s+ D
25.     Update
    : d4 w; N" Q2 W2 D1 K
26.     SPL(3).color = acCyan  '发现偏移后的结果不在是一条样条曲线，而是多条样条曲线
    
27.     Update
    : g& P# V5 F% V! G+ A
28.     SPL(5).color = acCyan  '发现偏移后的结果不在是一条样条曲线，而是多条样条曲线
    
29.     Update
    
30. End Sub
    / F5 G. o% r7 `$ V. @1 Z4 c3 T9 \

复制代码

! @0 ?0 y( a3 \, Z8 J" J  ~4 E

常用属性示例

其他简单属性略：重点理解一下样条曲线的起止点的切向矢量：StartTangent、EndStantgent。

可以理解为另外的一个控制点，这个点相对于样条曲线的起（端）点，用于指示起（端）点的方向。这个点到起（端）点的直线长度是 1 ，比如T（0）=1，T（1）=0，就是0度方向（相对于X轴）；T（0）=0.707，T（1）=0.707，就是45度方向（相对于X轴）。T（0）=-0.5，T（1）=-0.866，就是240度方向（相对于X轴）。如果三维参数都是0，就是不指定方向（用CAD的默认方向）。

按照CAD的规定，三维参数的平方和应该是1，不过不是1也行。反正就是按三维坐标算角度。当然，尽量按CAD的要求来，以免意外出错。即用三维坐标指示方向。
. O- T3 o& o, W$ m! @+ z

1. Sub 样条曲线的常用属性()
   5 d( }0 {4 ^- z5 j* E' W2 Z
2.     Dim P(299) As Double, SP As AcadSpline
   
3.     Dim startTan(0 To 2) As Double
   
4.     Dim endTan(0 To 2) As Double
   ; t* Q7 R! u! }
5.     Dim M%
   + c' b7 n6 y+ W) O. [
6.     Const π As Double = 3.14159265358979
   
7.     For M = 1 To 100
   6 u8 @* A3 G2 k; w1 a- \
8.         P(3 * M - 3) = M * 0.1
   
9.         P(3 * M - 2) = Sin(M * π / 10)
   
10.         P(3 * M - 1) = 0
    
11.     Next
    
12.     startTan(0) = 5: startTan(1) = 5: startTan(2) = 0
    
13.     endTan(0) = 10: endTan(1) = 10: endTan(2) = 0
    ' @8 H0 O5 }# j5 x7 `* e, u
14.     Set SP = ThisDrawing.ModelSpace.AddSpline(P, startTan, endTan)
    
15.     Update
    
16.     MsgBox SP.Degree    '不理解这个次数3是怎么定的？
    . v, O9 M/ U6 G# D: L; z" O
17.     Dim X As Variant
    
18.     X = SP.StartTangent    '获取的结果坐标是0.7071067,0.7071067,0
    & N8 ~9 M3 W. g* C- e+ u
19.     X = SP.EndTangent      '同上，其实就是2^0.5/2,2^0.5/2,0
    " a; c5 m! y" s; ]) N
20.     Dim p1(2) As Double, p2(2) As Double
    2 z: s- O* {& S1 J2 L
21.     p1(0) = 2: p1(1) = 7
    
22.     p2(0) = 6: p2(1) = 9
    
23.     SP.StartTangent = p1    '修改属性值，从新指定起点切向角
    4 z  z* U' O2 K7 v6 |; z
24.     Update
    8 m6 X5 _0 q0 @) C2 g8 S
25.     SP.EndTangent = p2      '修改属性值，从新指定终点切向角
    
26.     Update
    $ K4 A: x# v1 D5 U" O
27.     X = SP.StartTangent    '新的切向点坐标2,7,0
    ' @- p% z1 A7 V; c9 _! G5 J1 `
28.     X = SP.EndTangent      '新的切向点坐标6,9,0
    ; o0 t$ o8 P' _
29. End Sub
    

复制代码

kuangben8

C、画函数曲线

可以用样条曲线来画函数图像。

1. Sub 三角函数()
   
2.     Dim P(299) As Double, SP As AcadSpline
   
3.     Dim startTan(0 To 2) As Double
   $ G3 Y; s# \' u* b) J6 E
4.     Dim endTan(0 To 2) As Double
   ; y( @& W0 B  ^+ Z( X& n
5.     Dim M%
   
6.     Const π As Double = 3.14159265358979
   
7.     For M = 1 To 100
   
8.         P(3 * M - 3) = M * 0.1
   % c% @* M/ C: P1 ^6 b; b: W
9.         P(3 * M - 2) = Sin(M * π / 10)
   
10.         P(3 * M - 1) = 0
      [+ d! ]7 w8 l% ?  _- b5 l9 E
11.     Next
    8 r$ W4 o( K8 r( L* y( ~
12.     startTan(0) = 0: startTan(1) = 0: startTan(2) = 0      ‘都是0表示默认CAD切向
    1 Q) W7 f& R. ^2 b8 J% j
13.     endTan(0) = 0: endTan(1) = 0: endTan(2) = 0        ‘同上
    
14.     Set SP = ThisDrawing.ModelSpace.AddSpline(P, startTan, endTan)
    # D$ Z! A+ F  c0 o& v* y% e* y
15. End Sub
    

复制代码

1. Sub 二次函数()
   
2.     Rem Y=0.2*X^2+0.3*X-8
   
3.     Dim ps(902) As Double, SP As AcadSpline
   
4.     Dim startTan(0 To 2) As Double
   
5.     Dim endTan(0 To 2) As Double
   9 L" V+ t+ G" x% B
6.     Dim x#, y#
   7 f0 B8 U% d2 Z# E
7.     For x = -150 To 150
   4 B" Y+ ]9 I( _" @# r' T$ k& O/ I
8.         y = 0.2 * x ^ 2 + 0.3 * x - 8
   ! X# ^# ]5 }  k" D; Z% n% d. l: G
9.         ps(3 * (x + 151) - 3) = 0.1 * x
   / c4 b6 E4 l* t% U. f9 R
10.         ps(3 * (x + 151) - 2) = 0.01 * y
    6 z' `' W; Y7 R- n  K
11.         ps(3 * (x + 151) - 1) = 0          'Z坐标值不写也可以，默认为0
    1 @3 W" `+ ~- C
12.     Next
    - r! |! O2 f. ^
13.     startTan(0) = 0: startTan(1) = 0: startTan(2) = 0
    
14.     endTan(0) = 0: endTan(1) = 0: endTan(2) = 0
    5 h+ U* _8 T; Q7 r# j
15.     Set SP = ThisDrawing.ModelSpace.AddSpline(ps, startTan, endTan)
    
16. End Sub
    

复制代码

1. Sub 二次函数02()
   ' ?: [. t, B+ v0 ?& ^! @. N
2.     Rem Y=0.2*X^2+0.3*X-8
   
3.     Dim ps(902) As Double, SP As AcadSpline
   
4.     Dim startTan(0 To 2) As Double
   
5.     Dim endTan(0 To 2) As Double
   5 E" S& }( y0 C$ h* W% M3 f
6.     Dim x#, y#
   
7.     For x = -150 To 150
   
8.         y = 0.2 * x ^ 2 + 0.3 * x - 8
   
9.         ps(2 * (x + 151) - 2) = 0.1 * x
   - g$ I* B2 b% \! c
10.         ps(2 * (x + 151) - 1) = 0.01 * y
    # M' i; t0 G+ q6 l- \7 T
11.     Rem 样条曲线的点坐标默认每3个坐标为1个点，后续没有赋值的点默认为0，所以此例画出的是三维图像！
    
12.     Next
    9 [2 n2 d" P- v( w8 ~1 m
13.     startTan(0) = 0: startTan(1) = 0: startTan(2) = 0
    1 K4 W! C, L' A7 C- z
14.     endTan(0) = 0: endTan(1) = 0: endTan(2) = 0
    . I4 P7 B' k( u4 v
15.     Set SP = ThisDrawing.ModelSpace.AddSpline(ps, startTan, endTan)
    " I* O+ x0 r3 V+ T" h8 N3 P
16. End Sub
    

复制代码

1. Sub 任意函数()         '没成功！！！！！
   
2.     Dim ps(902) As Double, SP As AcadSpline
   + x" `* l! C6 u4 g
3.     Dim startTan(0 To 2) As Double
   5 O* K/ }& g6 \4 d' s5 L9 Z
4.     Dim endTan(0 To 2) As Double
   . S# G) b  h$ O' z! G( L4 w
5.     Dim x#, y#, F
   8 h% f' E5 `9 s4 M
6.     F = InputBox("请输入一个关于x的表达式：")
   ' K: ~5 l% s/ m9 A; W) }
7.     '    F = ThisDrawing.Utility.GetKeyword("请输入一个关于x的表达式：")   '该方法首先需要一个关键字列表，然后从中选择。
   1 Q+ B( a8 Q7 v" j& W6 }
8.     '    F = ThisDrawing.Utility.GetString(False, "请输入一个关于x的表达式：")   '直接返回字符串，后续不可用,使用val转换只能得到0
   
9.     '    F = ThisDrawing.Utility.GetInput()     '该方法首先需要一个关键字列表，然后从中选择。
   
10.     For x = -150 To 150
    
11.         y = Evaluate((Replace(F, "x", x)))  '在Excel中使用Evaluate函数可以取值(不能自动识别变量，需要用replace函数替换一下)。但是CAD中不行啊！用VAL函数转换也不行。
    2 L, O' T! T3 g! a2 ?
12.         ps(3 * (x + 151) - 3) = 0.1 * x
    
13.         ps(3 * (x + 151) - 2) = 0.01 * y
    
14.         ps(3 * (x + 151) - 1) = 0
    ! b  V8 M* D. @; S0 r* L. F
15.     Next
    
16.     startTan(0) = 0: startTan(1) = 0: startTan(2) = 0
    3 y5 j3 Q: f/ S* q) d. r
17.     endTan(0) = 0: endTan(1) = 0: endTan(2) = 0
    
18.     Set SP = ThisDrawing.ModelSpace.AddSpline(ps, startTan, endTan)
    
19. End Sub
    

复制代码

$ v! u5 e) z8 r

2.15、样条曲线对象(SpLine).zip (10.36 KB, 下载次数: 6)

2019-3-29 21:12 上传

点击文件名下载附件

kuangben8

16、椭圆对象(Ellipse)

A、添加椭圆方法(AddEllipse)

RetVal = object.AddEllipse(Center,MajorAxis, RadiusRatio)   

以上方法是给定中心点、长轴的一个端点和短轴与长轴半径比在WCS的XY平面上创建椭圆。

Center：Variant[变体] (三元素双精度数组); 仅用于输入指定椭圆中心点的三维WCS坐标。

MajorAxis：Variant[变体] (双精度); 用于输入长轴端点的三维WCS点坐标(相对中心点的相对坐标)。

RadiusRatio：Double[双精度]; 仅用于输入定义椭圆短轴与长轴比例的正值(0<RadiusRatio≤1)。半径比为1.0时定义的是圆。比值越小越扁。

RetVal：结果就是新创建的椭圆对象。

说明

椭圆可以是闭合的或开放的(即椭圆弧)，它创建于当前WCS的XY面上。该对象表示一个真正的椭圆，而不是多段线拟合的椭圆。要画椭圆弧必须先画椭圆，然后修改椭圆的起始角和终止角属性值来画椭圆弧。
" m6 Y7 B' M5 {4 g

1. Sub AddEllipse方法01()
   - }# |* Z& k4 L
2.     ' 该示例在模型空间中创建椭圆。
   
3.     Dim ellObj As AcadEllipse
   
4.     Dim majAxis(0 To 2) As Double
   
5.     Dim center(0 To 2) As Double
   ' T5 I; s6 V: W3 L% X8 X! k
6.     Dim radRatio As Double
   
7.     Rem 其中第二参数majAxis表示的点坐标是相对第一参数的相对坐标
   
8.     Rem 在绘制的图中第二参数表示的点在长轴的一个端点上。需注意！！
   
9.     center(0) = 5#: center(1) = 5#: center(2) = 0#
   * e. c, w, v5 a1 n
10.     majAxis(0) = 10: majAxis(1) = 20#: majAxis(2) = 0#  '只输入一个值，默认另两个坐标为0
    # _6 V% a2 T2 c. A. `6 N
11.     radRatio = 0.3
    ; L1 y) }7 u9 U# ?2 u( ^9 e
12.     Set ellObj = ThisDrawing.ModelSpace.AddEllipse(center, majAxis, radRatio)
    
13.     Update
    
14.     Call ThisDrawing.ModelSpace.AddLine(center, majAxis)
    7 U# o0 b$ K7 v7 R
15.     '直线的终点坐标是绝对坐标，所以不在椭圆的端点上。
    
16.     Update
    0 r  ~+ a9 O& p7 Z- E$ }! V+ N
17. End Sub
    

复制代码

可以使用椭圆方法画一个灯笼：)
' F; V; n* }  H% q  u

1. Sub AddEllipse方法画灯笼()
   $ B0 _+ C  w" J5 Z/ }7 w
2.     Dim ellObj As AcadEllipse
   
3.     Dim majAxis(0 To 2) As Double
   - j- f9 H3 ?3 |) F
4.     Dim center(0 To 2) As Double
   3 X2 c! |9 {/ W& O$ C! V0 J
5.     Dim radRatio As Double, m%
   
6.     For m = 1 To 20
   
7.         center(0) = 5: center(1) = 5: center(2) = 0
   
8.         majAxis(0) = 10: majAxis(1) = 20: majAxis(2) = 0
   
9.         radRatio = (m - 1) * 0.05 + 0.05 '取值范围大于0，小于等于1
   
10.         Set ellObj = ThisDrawing.ModelSpace.AddEllipse(center, majAxis, radRatio)
    $ g2 x/ s/ a0 W' N% Z( O) H4 F
11.         Update
    
12.         ellObj.Copy
    
13.         ellObj.Rotate center, 3.1415926 / 2   '绘制的椭圆先复制后绕中心旋转90°
    
14.         Update
    " n* G& h# T4 q
15.     Next
    
16.     Dim p1(2) As Double, p2(2) As Double, L As AcadLine
    
17.     p1(0) = majAxis(0) + center(0): p1(1) = majAxis(1) + center(1)
    
18.     p2(0) = -majAxis(0) + center(0): p2(1) = -majAxis(1) + center(1)
    
19.     Set L = ThisDrawing.ModelSpace.AddLine(p1, p2)
    
20.     Update
    - x$ z1 d9 E" Z- \
21.     L.Copy
    
22.     L.Rotate center, 3.1415926 / 2 '直线先复制，后绕中心旋转90°
    : B% z/ Q- |2 c: u% s$ e, Z
23.     Update
    , ^8 \" l- |3 C% N
24. End Sub
    

复制代码

5 q) _1 n; m/ D& ^

kuangben8

B、椭圆对象(Ellipse)的常用方法及属性

椭圆对象的常用方法与其他对象一样,并没有特别的方法,常用的方法如:Copy、Delete、IntersectWith、Mirror、Move、Offset、Rotate、Update……具体语法不再赘述,参考示例如下:

需注意:椭圆对象偏移后的结果对象(数组)的图元不再是椭圆，而是样条曲线。

1. Sub 椭圆常用方法()
   & ?) H* s+ |0 N% K9 d7 [" ^
2.     Dim ell As AcadEllipse
   
3.     With ThisDrawing
   
4.         Set ell = .ModelSpace.AddEllipse(.Utility.GetPoint(, "请选择椭圆中心点"), .Utility.GetPoint(, "请选择椭圆的长轴端点"), .Utility.GetReal("请输入椭圆半径比(0,1]"))
   
5.     End With
   ! k. D% v8 k" Q9 Z/ _# Z
6.     Update
   
7.     Rem 上面的写法在选择第二个参数时不会产生一条弹性线跟随鼠标动
   : t" V6 B! X2 T4 E4 i( p1 M0 ]
8.     Dim P0 As Variant
   
9.     With ThisDrawing
   5 H+ g( p7 o/ A$ k9 G
10.         P0 = .Utility.GetPoint(, "请输入椭圆中心点")
    
11.         Set ell = .ModelSpace.AddEllipse(P0, .Utility.GetPoint(P0, "请选择椭圆的长轴端点"), .Utility.GetReal("请输入椭圆半径比(0,1]"))
    % `; o0 o* D, G+ J" L1 u
12.         Update
    
13.         Rem 上面的写法则可以在选择第二个参数时从第一个点到鼠标之间有一条弹性线跟随鼠标动。
    
14.         Rem 不管是点选还是输入的坐标，均是将第二个参数坐标值按照第一个参数中心点的相对坐标来绘制椭圆。
    
15.         Dim ells As Variant
    
16.         ell.Copy
    # {0 z3 F3 [9 ~1 O1 h9 u6 ]
17.         Update
    $ p) o  U) T3 w1 U+ s' G
18.         ell.Move .Utility.GetPoint(, "请选择移动的第一个点"), .Utility.GetPoint(, "请选择移动的第二个点")
    ) h# K# B! ]" U
19.         Update
    
20.         ells = ell.Offset(.Utility.GetReal("请输入偏移距离，正外移，负内移"))    '偏移结果是新对象数组，而且图元不再是AcadEllise，而是样条曲线
    & X7 ?: }5 @. Z, K" N
21.         Update
    0 ]8 R( w5 w. w. w
22.         ells(0).Rotate .Utility.GetPoint(, "请选择旋转的中心点"), .Utility.AngleFromXAxis(.Utility.GetPoint(, "请选择旋转角的第一个点"), .Utility.GetPoint(, "请选择旋转角的第二个点"))
      T- Y4 _- T+ W
23.         Rem 上面旋转时先提示第一个点，再提示第二个点，最后提示中心点。。。？？这是为啥？
    
24.         Update
    
25.         ells(0).Mirror .Utility.GetPoint(, "请选择镜像轴的第一个点"), .Utility.GetPoint(, "请选择镜像轴的第二个点")
    " S8 y$ r! }: U, U2 B; l
26.         Update
    ; O( Y, I$ }( b/ H% G' ]
27.         Dim PS As Variant
    
28.         PS = ell.IntersectWith(ells(0), acExtendBoth)  '若相交，获取交点坐标数组，不能直接使用msgbox显示。
    
29.         Dim obj As Object
    6 F' e$ i+ n9 r- D0 O$ W" K0 ]
30.         For Each obj In .ModelSpace
    1 K+ b+ {9 I; P
31.             If TypeOf obj Is AcadEllipse Then
    ) }  O4 ^% y: y7 _* @# g2 ?9 }. o
32.                 obj.Delete
    
33.                 Update
    
34.             End If
    
35.         Next
    9 c( O( v; z# M& I
36.     End With
    2 \9 I( `1 W5 H: d
37. End Sub
    5 s6 J2 D/ u2 \! i. B

复制代码

4 X  k3 ?  `% J  [( u* ?7 |6 n

椭圆对象的常用属性:其他简单的属性参考示例理解。

1. Sub 椭圆常用属性()
   
2.     Dim ell As AcadEllipse, x As Variant
   8 t; n' C/ @* k- ?; W( u2 C2 L  |
3.     Dim p1(2) As Double, p2(2) As Double, S As Double
   
4.     p1(0) = 5: p1(1) = 5
   
5.     p2(0) = 15: p2(1) = 15
   1 W* [7 E5 {: y
6.     S = 0.37
   
7.     Set ell = ThisDrawing.ModelSpace.AddEllipse(p1, p2, S)
   6 ]$ ]* x9 C' l/ c+ q" [
8.     Update
   
9.     x = ell.Area            '获取椭圆的面积523.0752，只读属性
   
10.     x = ell.center          '获取椭圆的中心(5,5,0)
    
11.     ell.center = ThisDrawing.Utility.GetPoint()    '也可以修改中心属性，相当于移动
    
12.     x = ell.EndAngle        '获取椭圆的终止角，完整椭圆终止角是2π弧度，可修改
    $ l' {  a8 l, @( ?, n
13.     x = ell.StartAngle      '获取椭圆的起始角，完整椭圆的起始角是0弧度，可修改
    
14.     x = ell.StartParameter  '获取椭圆的起始参数，完整椭圆的起始角是0弧度，可修改
    ' c( T3 r! J- R# _5 O
15.     x = ell.EndParameter    '获取椭圆的终止参数，完整椭圆终止角是2π弧度，可修改
    
16.     x = ell.EndPoint        '椭圆终点坐标，(20,20,0),也就是第二参数指定的长轴端点的绝对坐标，只读属性
    
17.     x = ell.StartPoint      '椭圆起点坐标，(20,20,0),也就是第二参数指定的长轴端点的绝对坐标，只读属性
    6 @1 o* y# a! |% }
18.     x = ell.RadiusRatio     '获取椭圆的短轴和长轴半径比，可修改
    % g6 @3 x$ W5 U% m
19.     x = ell.MajorAxis       '获取椭圆长轴端点坐标(15,15,0),是相对中心点的相对坐标
    
20.     x = ell.MajorRadius     '获取椭圆长轴半径
    4 ~  w  E, G' Y# r5 a1 x
21.     x = ell.MinorAxis       '获取椭圆短轴端点坐标(-5.55,5.55,0),逆时针旋转先经过的短轴端点坐标(相对中心的相对坐标)
    ' F0 j" O$ E! \6 C" }$ Y' e7 [0 J% E
22.     x = ell.MinorRadius     '获取椭圆短轴半径
    
23. End Sub
    # l+ X1 N) e7 L

复制代码

+ V+ l0 m/ D* z% p1 N4 k* v

$ E( `7 Z; p- q) A: _

kuangben8

C、创建椭圆弧对象

下面介绍一下通过修改椭圆的属性来创建椭圆弧：

1、Ellipse.EndParameter属性：指定椭圆的终点参数角，[double]可读写，范围在[0,2π]

Ellipse.StartParameter属性：指定椭圆的起点参数角，[double]可读写，范围在[0,2π]

椭圆的起、终点坐标与起、终点参数角关系按如下方程计算(按照椭圆所在面为XY平面，Z坐标默认0)。起、终点P的坐标为：P(X) =A * cos(θ) ,P(Y)= B * sin(θ)

以上坐标公式是在对象坐标系OCS中成立。在绝对坐标中仅中心点在(0,0,0),指定长轴端点在水平向右方向时成立！

起、终点参数角弧度的确认：以椭圆中心点为坐标原点，指定的椭圆长轴端点为X轴正方向，逆时针旋转为正角。但是实际得到的起、终点对应角度不一定是指定的参数角。

其中A与B是椭圆的半长轴与半短轴。θ是指定的起、终点参数角弧度值。

2、Ellipse. StartAngle属性：指定椭圆的起点角弧度，[double]可读写，范围在[0,2π]

Ellipse. EndAngle属性：指定椭圆的终点角弧度，[double]可读写，范围在[0,2π]

起、终点角弧度的确认：以椭圆中心点为坐标原点，指定的椭圆长轴端点为X轴正方向，逆时针旋转为正角。实际得到的起、终点对应的角度就是指定的起、终点角度。

3、角弧度θ和参数角弧度α的关系：tan(θ)=b*tan(α)   (b是半短轴与半长轴半径比)

可以用角弧度或参数角弧度来画一个椭圆。
/ L% l( Q* K/ ?5 O% s9 m. O+ a

1. Sub 椭圆起止参数和角度属性()
   / K8 f# Q% m: F9 o
2.     '此示例创建椭圆，并输入开始和结束参数以创建椭圆弧。
   
3.     Dim ellObj As AcadEllipse, ellobje As AcadEllipse
   
4.     Dim majAxis(0 To 2) As Double
   
5.     Dim center(0 To 2) As Double
   % C; z( r' h/ ^+ E( P0 x5 A
6.     Dim radRatio As Double
   
7.     Dim p1(2) As Double, p2(2) As Double
   
8.     center(0) = 5#: center(1) = 5#: center(2) = 0#
   2 G4 Y- a7 \; |
9.     majAxis(0) = -10: majAxis(1) = -20#: majAxis(2) = 0#
   
10.     radRatio = 0.3
    
11.     Set ellObj = ThisDrawing.ModelSpace.AddEllipse(center, majAxis, radRatio)
    . H( T3 q# N2 m! P% I5 ~; |9 f
12.     Set ellobje = ellObj.Copy
    
13.     p1(0) = 5: p1(1) = 5
    
14.     p2(0) = 20: p2(1) = 5
    ! B- x3 F% ~8 q2 P' B5 q  B( ^8 H8 ^
15.     ellobje.Move p1, p2
    7 L2 c' h* w3 {- x* ^3 a, g0 F
16.     Update
    & V& e9 K' ?5 m) [" A8 i
17.     ' 输入开始参数1.57，结束参数6.28,可创建椭圆弧
    / a6 ]+ l0 c' l& \  l7 |
18.     '角度的基准线是按照创建椭圆的中心点为原点，第二参数指定的端点为X轴正方向，逆时针旋转为正角。
    
19.     ellObj.StartParameter = 3.1415926 / 2       '起始参数π/2=90°图上显示的角度也是90°。
    " }6 u1 n5 h# j
20.     Update
    7 {! j3 w1 b/ S1 r# z0 k. d5 ^
21.     ellObj.EndParameter = 5 * 3.1415926 / 3     '终止参数为5π/3=300°，但是图上显示的是332.542919°
    
22.     Update
    # |, ?0 u2 |1 D, D6 `9 u
23.     Rem 下面通过修改起止角弧度来创建椭圆弧
    7 w1 G, H3 s: H' D
24.     '角度的基准线是按照创建椭圆的中心点为原点，第二参数指定的端点为X轴正方向，逆时针旋转为正角。
    $ [. z6 b% h& w' A+ ~9 G
25.     ellobje.StartAngle = 3.1415926 / 2          '起始角度为π/2=90°
    
26.     Update
    ! E; L( k7 Z0 f9 l
27.     ellobje.EndAngle = 5 * 3.1415926 / 3        '终止参数为5π/3=300°
    - G- u0 b  N( m. c7 W
28.     Update
    0 A1 i" x: a1 ^' l
29.     Dim x As Variant
    
30.     x = ellobje.StartPoint   '从指定的长轴端点开始逆时针旋转先经过的点为起点
    
31.     x = ellobje.EndPoint     '从指定的长轴端点开始逆时针旋转后经过的点为终点
    
32. End Sub
    

复制代码

1. Sub 角度与参数角属性01()
   
2.     Dim ell As AcadEllipse, p0(2) As Double, p1(2) As Double, b As Double
   $ B6 P' d  `1 d1 T% z/ Z4 ]
3.     p0(0) = 0: p0(1) = 0      '便于观察，将中心点设置在坐标原点处
   
4.     p1(0) = 20: p1(1) = 0     '为了方便操作观察，半长轴为20，沿中心点水平向右
   , O+ {2 T# e+ d" H& @: y9 C
5.     b = 0.5                   '半短轴为10
   
6.     Set ell = ThisDrawing.ModelSpace.AddEllipse(p0, p1, b)
   0 W, Y# \% p2 W, w4 t, b; p: [
7.     Update
   . l( G% i) r, v9 E
8.     Rem 接下来设置起终点的参数角弧度属性
   
9.     Const π As Double = 3.14159265358979
   
10.         ell.StartParameter = π / 4
    
11.     '设置起点参数角为45°，根据公式计算的起点坐标应为(20*cos(45°)=10*2^0.5,10*sin(45°)=5*2^0.5)
    
12.     '结果起点坐标根据公式计算正确！但是起点所在角度并不是45°，而是26.565051°
    * X: k! G1 t: a0 `) V- d
13.     Update
    
14.         ell.EndParameter = 5 * π / 3
    # @1 u  l1 c3 w8 ]( p7 ]% {
15.     '设置终点参数角为300°，根据公式计算的终点坐标应为(20*cos(300°),10*sin(300°))
    - J* A4 s5 U0 n+ v! R
16.     '结果终点坐标根据公式计算正确！但是终点所在角度并不是-60°，而是-40.893395°
    
17.     Update
    
18.     Rem 接下来设置起终点的角弧度属性
    4 U5 T( l9 h, Q& v
19.     '    ell.StartAngle = π / 4
    
20.     '    ell.EndAngle = 5 * π / 3
    - ~& ]2 m, X2 y- `& Y
21.     Update   '发现起终点角度属性就是根据圆心及指定的长轴端点为X轴正方向逆时针旋转对应角度。
    
22.     ell.StartParameter = 1.10714871779409   '该弧度角的正切值为2=tan(π/4)/0.5
    
23.     ell.EndParameter = -1.28976142529208    '该弧度角的正切值为-3.46410161513775=tan(5*π/3)/0.5
    
24.     Update   '通过上例证明角度与参数角满足关系tan(角度)=椭圆半径比*tan(参数角)
    3 o( m% r! k% b- j
25. End Sub
    . E  V: {7 E: z& p

复制代码

+ o" ]5 M% F+ m. T8 V$ F3 s5 i
2.16、椭圆对象命令(Ellipse).zip (11.71 KB, 下载次数: 9)

2019-3-29 21:19 上传

点击文件名下载附件

6 p7 l: ?, ]& A/ j: G3 X

kuangben8

3 ~5 f) W0 D$ p& E
6 m2 @! G3 X' J4 d三、实现Excel与AutoCAD之间数据交互
' {, m: l& d3 l( Z* t; `1、通过Excel编程调用指定AutoCAD文档自动画图
* z/ T) ?* j9 v: V2 R( I: A

需注意:通过Excel调用AutoCAD程序文档之前,需要在Excel的VBE窗口中:工具---→引用,在弹出的窗口中必须勾选本机对应的AutoCAD程序库才可以正常调用CAD程序及文档.如下图所示:

基本调用方法如下：

1. Sub 调用CAD方法02()
   3 V$ s& w6 X- W- }) C% Q% r& n
2.     Dim CAD As AcadApplication, DOC As AcadDocument
   # U4 l" X' E' ], W
3.     Set CAD = CreateObject("AutoCAD.Application") '运行一个新的CAD进程
   9 s9 H7 l8 ^6 ~
4.     CAD.Visible = True '让新的CAD进程可见，这可以在CAD图形界面手工操作。否则只能用EXCEL在后台操作
   
5.     '也可以用下面这行
   8 H/ @6 X. i7 K) x/ o4 @
6. '    Set CAD = GetObject(, "AutoCAD.Application") '获得一个已经运行的CAD进程,在已经有CAD文档打开时使用！
   - c2 T3 F' @# r3 z" {
7.    
   
8.     '指定要使用的文档的方法,可选用下面五行之一
   
9. '    Set DOC = CAD.ActiveDocument '指定使用活动（正在前台的）CAD文档
   
10.     Set DOC = CAD.Documents.Open(ThisWorkbook.Path & "\CAD编程文件.dwg") '打开一个指定路径指定名称的CAD文档，打开后只有一个指定CAD文档窗口
    
11. '    Set DOC = CAD.Documents.Add() '新建一个CAD文档
      j/ V! P8 R9 m
12. '    Set DOC = CAD.Documents.Item(0) '指定当前已经打开的文档中的某一个——用索引号指定。
    0 }' n+ ^# L( Q, c
13.     Rem 索引号从0开始，最大索引号比已经打开的文档数（Documents对象的Count属性）小1。
    
14. '    Set DOC = CAD.Documents.Item("CAD编程文件.dwg") '指定当前已经打开的文档中的某一个——用文件名指定
    % L1 b9 q9 W' _: g
15.    
    
16.     DOC.Activate '使指定的文档成为活动文档
    4 f/ X) K; j2 M; h, Y8 P2 a- m
17.     DOC.SaveAs ThisWorkbook.Path & "CAD编程文件.dwg" '保存CAD文档到指定路径下的指定文档。
    
18.     CAD.Quit '如果运行一个新的CAD进程时，仅仅用于后台操作或完成辅助计算等，用过之后别忘了关闭它。否则每使用一次本程序就运行一个新CAD进程，次数多了电脑内存会吃不消的.
    # E5 f7 ]1 s# r/ L* h1 ]
19. '    CAD.Close False   '没有CAD.Close方法!
    
20. 'CAD.Documents.CLOSE FALSE    '关闭文档可行。
    . P, ~5 J4 K( x- r# L: W% E
21. End Sub
    ) ]  _+ }- Z, P: t

复制代码

也可参考如下代码：

1. Sub 调用CAD程序()
   2 \8 o5 ^0 D6 o' U8 {" B. l& T
2.     Rem 首先一定要在工具---引用---中勾选对应的CAD版本的引用库 AutoCAD 2014 Type Library
   # Y  y$ q# p8 U5 A* ^! `
3.     Dim CAD As AcadApplication, DOC As AcadDocument
   & l/ U3 x; E" o
4.     On Error Resume Next      '忽略错误继续运行
   $ |6 Q9 {) v. d" L* Q
5.     Set CAD = GetObject(, "AutoCAD.Application")   '若已经打开CAD程序时使用
   
6.     If CAD Is Nothing Then
   0 r# z, ^% w) V) p% H3 P/ H
7.         Err.Clear   '清除错误
   & p- N" l* }/ G9 |* k8 K. W
8.         Set CAD = CreateObject("AutoCAD.Application")  '若没有打开CAD程序时使用
   
9.     End If
   ( w) i3 g. p: R: {% V
10.     'CAD.Visible = True  '让CAD界面显示出来
    / }. m1 }8 N) K; a: }8 R
11.     Set DOC = CAD.Documents("设计绘图模板.dwg")    '不要.Item也可以。直接赋值如没有则出错！
    5 x4 ?4 H7 h0 p- n$ ^2 G+ o4 b
12.     If DOC Is Nothing Then
    
13.         Err.Clear
    
14.         Set DOC = CAD.Documents.Open(ThisWorkbook.Path & "\设计绘图模板.dwg")
    3 |8 m0 i" x8 E/ ]9 J* S1 _& M
15.     End If
    $ N1 N! @6 ]2 q% Q1 v4 |3 u( q) z
16.     On Error GoTo 0      '恢复错误提示
    
17.     CAD.Visible = True   '此时显示界面不会出现空白CAD文档！
    
18.     DOC.Activate         '激活指定文档
    
19.     With DOC             '相当于CAD的VBE里的with Thisdrawing
    
20.         Rem 接下来就相当于在CAD的VBE中编写代码一样了！
    
21.         Rem 方法一：以发送命令的方式画图
    , M8 I: q+ D& n
22.         Dim obj As Object
    & C3 o- X& d% N! K) r
23.         For Each obj In .ModelSpace
    
24.             obj.Delete     '删除对象不会及时显示出来
    
25.             .Application.Update
    
26.             '刷新CAD界面，直接Update单步执行没问题，但是直接运行，此步提示远程服务器不存在！,使用.Application.Update却没有问题！
    - U% f* e, ~& `
27.         Next
    2 W! k+ w! T' r& @( S/ S& {
28.         Rem 发送命令的形式绘图可以及时的显示出来
    
29.         .SendCommand Sheet1.Cells(2, 1).Value
    3 W- \; H0 j0 V. T/ F/ |
30.         .SendCommand Sheet1.Cells(3, 1).Value
    
31.         .SendCommand Sheet1.Cells(4, 1).Value
    
32.         
    
33.         Rem 方法二：直接编写代码画图
    
34.         Dim L As AcadLine, Cir As AcadCircle
    
35.         Dim p01(2) As Double, p02(2) As Double
    2 e2 j; W  ^1 L7 Y! m9 \& Q
36.         Dim cnt(2) As Double, R As Double
    
37.         With Sheet1
    
38.             p01(0) = .Cells(8, 1).Value
    
39.             p01(1) = .Cells(9, 1).Value
    9 |4 F  b6 G' k/ [; ^
40.             p01(2) = 0  'Z坐标也可以省略不写，默认是0
    2 f. D% j* m* v$ \9 G+ s$ P
41.             p02(0) = .Cells(10, 1).Value
    
42.             p02(1) = .Cells(11, 1).Value
    , u0 R; W: b, ]' g
43.             
    . _+ @* X% P1 i' a/ o8 c. r
44.             cnt(0) = .Cells(10, 1).Value
    6 s5 D: P* D7 c/ A
45.             cnt(1) = .Cells(11, 1).Value
    ! k: l- `1 {; ?8 ]8 W, g. N. _
46.             cnt(2) = 0
    
47.             R = .Cells(8, 2).Value
    
48.         End With
    
49.         Set L = .ModelSpace.AddLine(p01, p02)
    
50.         L.Update    '单独的Update单步执行没问题，直接运行同样错误，但是使用对象刷新也没问题！
    , t) G9 T( F+ t
51.         Set Cir = .ModelSpace.AddCircle(cnt, R)
    
52.         Cir.Update
    6 R' @, Z1 J& o# p3 D2 a' E* l* d
53.         cnt(0) = Sheet1.Cells(9, 2).Value
      I8 b4 Q/ j5 A6 V; Y
54.         cnt(1) = Sheet1.Cells(10, 2).Value
    
55.         cnt(2) = 0
    
56.         R = Sheet1.Cells(11, 2).Value
    % X* l2 i4 x  V$ f
57.         Set Cir = .ModelSpace.AddCircle(cnt, R)
    
58.         .Application.Update
    
59.         
    
60.     End With
      ]% I9 N7 g3 a" v& L
61.     'DOC.Save        '保存修改的CAD文档
    
62.     DOC.Close True  '或者直接关闭并保存修改的CAD文档
    
63.     CAD.Quit        '结束CAD进程
    3 F1 p2 _, N! b$ C8 K: r
64.     Set DOC = Nothing   '释放变量
    $ D  [& F* f" X7 G% Z8 N
65.     Set CAD = Nothing
    : d% i3 l2 d# J. `/ `% t5 ]
66. End Sub

复制代码

Excel与AutoCAD 交互编程.zip (49.62 KB, 下载次数: 22)

2019-6-30 22:59 上传

点击文件名下载附件

通过以上方法调用CAD程序也叫前期绑定，其好处就是在编写代码时，能够自动提示对应对象的属性和方法，方便初学者学习使用。
/ F7 l/ {5 W' I& R! r其坏处就是当你把代码文件发送给别人使用时，别人也必须在VBE里工具---引用中勾选对应类型库才能正常运行代码。

4 c$ X; v2 g$ m1 A
( e, R4 X. i" j; ?* y所以还有另一种调用CAD程序的方法：后期绑定。其好处就是不用在VBE里工具---引用中勾选对应的类型库，代码发给别人可以直接运行。
其坏处就是在编写代码时不会有任何提示。需要编写者有一定的基础，至少知道有哪些方法、属性可用。
# }+ l2 R5 E; f

/ W) a$ O8 V$ y4 \& e: P初学建议写代码时采用前期绑定的方式，写好后再改成后期绑定的方式即可。
" a" d+ l& j" r* M5 O$ E0 l后期绑定代码如下：
( g$ t0 D3 H, @6 y- c/ r6 q

1. Sub 调用CAD程序_后期绑定()
   
2.     Rem 不需要在工具---引用---中勾选对应的CAD版本的引用库 AutoCAD 2014 Type Library
   8 y- u5 R0 h" G
3.     Dim CAD As Object, DOC As Object
   
4.     On Error Resume Next      '忽略错误继续运行
   
5.     Set CAD = GetObject(, "AutoCAD.Application")   '若已经打开CAD程序时使用
   
6.     If CAD Is Nothing Then
   
7.         Err.Clear   '清除错误
   3 J+ i/ D$ }( H4 ]! X: `6 ]& O5 f
8.         Set CAD = CreateObject("AutoCAD.Application")  '若没有打开CAD程序时使用
   . P  c1 k5 F7 J+ q1 `5 N
9.     End If
   
10.     'CAD.Visible = True  '让CAD界面显示出来
    
11.     Set DOC = CAD.Documents("设计绘图模板.dwg")    '不要.Item也可以。直接赋值如没有则出错！
    ; L4 N/ w6 c; `$ C6 D* b9 S
12.     If DOC Is Nothing Then
    & P+ c3 L0 b6 _7 F+ J
13.         Err.Clear
    * v# S) I: |& R5 F
14.         Set DOC = CAD.Documents.Open(ThisWorkbook.Path & "\设计绘图模板.dwg")
    
15.     End If
    6 G" {5 B* B/ ^; B6 Z! b1 U
16.     On Error GoTo 0      '恢复错误提示
    / |3 [4 K/ [7 {& \$ G0 ~9 i: Z
17.     CAD.Visible = True   '此时显示界面不会出现空白CAD文档！
    4 G0 K  X" A$ N+ a# Y; j- f0 i3 A
18.     DOC.Activate         '激活指定文档
    
19.     With DOC    '相当于CAD的VBE里的with Thisdrawing
    $ K! S* q, _" ^. |
20.         Rem 接下来就相当于在CAD的VBE中编写代码一样了！
    
21.         Rem 方法一：以发送命令的方式画图
    ( j0 j5 c7 t- Q) _0 s- Z* Q
22.         Dim obj As Object
    
23.         For Each obj In .ModelSpace
    
24.             obj.Delete     '删除对象不会及时显示出来
    ' W+ y" B3 F6 F4 F% N
25.             .Application.Update
    0 a0 z- d1 E0 O3 c* x/ y, q# O
26.             '刷新CAD界面，直接Update单步执行没问题，但是直接运行，此步提示远程服务器不存在！,使用.Application.Update却没有问题！
    0 d& F; T# m& D1 p
27.         Next
    
28.         Rem 发送命令的形式绘图可以及时的显示出来
    
29.         .SendCommand Sheet1.Cells(2, 1).Value
    
30.         .SendCommand Sheet1.Cells(3, 1).Value
    / k/ p7 ?# Y5 Z2 [5 S
31.         .SendCommand Sheet1.Cells(4, 1).Value
    6 v0 a1 n, T& ~3 {% L. R
32.         
    
33.         Rem 方法二：直接编写代码画图
    
34.         Dim L As Object, Cir As Object      'AcadLine和AcadCircle在后期绑定中也不能事先定义了！
    % h( m5 G' [; w2 U& u1 _3 D$ Y
35.         Dim p01(2) As Double, p02(2) As Double
    ! {* l5 F8 H! |% @# {- N7 U; o6 q; y
36.         Dim cnt(2) As Double, R As Double
    
37.         With Sheet1
    
38.             p01(0) = .Cells(8, 1).Value
    
39.             p01(1) = .Cells(9, 1).Value
    
40.             p01(2) = 0  'Z坐标也可以省略不写，默认是0
    4 U2 j. {5 D; t2 [  R1 Z% y: g. i
41.             p02(0) = .Cells(10, 1).Value
    * r% \( P1 D, }* ^- p. u5 N
42.             p02(1) = .Cells(11, 1).Value
    * d0 |( f6 b. O* B  z
43.             
    
44.             cnt(0) = .Cells(10, 1).Value
    ( w6 ~( |5 o( J- s- y
45.             cnt(1) = .Cells(11, 1).Value
    ) ^, A: f1 j( z! r" n6 T6 E9 Z
46.             cnt(2) = 0
    
47.             R = .Cells(8, 2).Value
    " R& z! \: M5 a/ K, O' l
48.         End With
    
49.         Set L = .ModelSpace.AddLine(p01, p02)
    4 M0 V% O, {- O) [: p
50.         L.Update    '单独的Update单步执行没问题，直接运行同样错误，但是使用对象刷新也没问题！
    , K& s4 I3 z) W+ N/ b
51.         Set Cir = .ModelSpace.AddCircle(cnt, R)
    
52.         Cir.Update
    ' y  w0 m6 i: y, C
53.         cnt(0) = Sheet1.Cells(9, 2).Value
    * M# o* p) Q1 o% i+ N
54.         cnt(1) = Sheet1.Cells(10, 2).Value
    " c/ w; H* D) N# T
55.         cnt(2) = 0
    
56.         R = Sheet1.Cells(11, 2).Value
    
57.         Set Cir = .ModelSpace.AddCircle(cnt, R)
    9 F  M" L& T$ \5 R
58.         .Application.Update
    - r/ o" h2 G: }# U* ?$ r% T
59.         
    " T! l5 }# g1 K! [, l
60.     End With
    & |, C8 b* g% j0 }7 z
61.     'DOC.Save        '保存修改的CAD文档
    3 }0 ^6 q1 B8 D, M+ @7 o  P
62.     DOC.Close True  '或者直接关闭并保存修改的CAD文档
    ) m, [: g) e2 Y
63.     CAD.Quit        '结束CAD进程
    
64.     Set DOC = Nothing   '释放变量
    ; E5 K! L3 u, Z
65.     Set CAD = Nothing
    7 H. m9 E5 _! x. l+ X
66. End Sub

复制代码

对比两个代码，你发现不同点了吗？

kuangben8

/ N4 ~; s& W0 [1 l" O0 G
2、通过AutoCAD编程调用Excel数据自动绘图
明白了使用Excel调用CAD,在使用CAD调用Excel则简单多了。套路都是差不多的！
5 T/ c$ n+ u: _) j7 O& f具体参考如下代码即可。
9 e) |) Q4 `8 R% i5 o- @$ {4 V* Z

1. Sub 调用Excel程序()
   
2.     Rem 首先一定要在工具---引用---中勾选对应的Excel版本的引用库 Microsoft Excel 16.0 Object Library
   
3.     Dim ExcelApp As Excel.Application, EWB As Excel.Workbook, ESHT As Excel.Worksheet
   : k' q: y) G  ?2 K, X/ `$ G
4.     On Error Resume Next      '忽略错误继续运行
   
5.     Set ExcelApp = GetObject(, "Excel.Application")   '若已经打开Excel程序时使用
   
6.     If ExcelApp Is Nothing Then
   
7.         Err.Clear   '清除错误
   ( j& k1 i- Y! j! u2 U# `
8.         Set ExcelApp = CreateObject("Excel.Application")  '若没有打开Excel程序时使用
   : r5 ~- V3 x( n; [8 f! W
9.     End If
   % Q" T9 e" R6 d9 u" I$ \' _
10.     'ExcelApp.Visible = True  '让Excel界面显示出来,是一个没有工作表的空白的Excel文档，但是后续指定工作簿后也不会出现一个空白Excel文档。
    
11.     Set EWB = ExcelApp.Workbooks("Excel工作簿.xlsx")    '不要.Item也可以。直接赋值如没有则出错！
    
12.     If EWB Is Nothing Then
    
13.         Err.Clear
    
14.         Set EWB = ExcelApp.Workbooks.Open(ThisDrawing.Path & "\Excel工作簿.xlsx")
    
15.     End If
    
16.     On Error GoTo 0      '恢复错误提示
    
17.     Set ESHT = EWB.Worksheets("实验工作表")
    ' L$ H4 n' W/ B; _
18.     ExcelApp.Visible = True   '此时显示界面不会出现空白Excel文档！
    
19.     ESHT.Activate
    ! j; I/ i6 _1 a9 \$ J
20.     With ESHT
    
21.         Dim arr, brr
    7 f& ^9 F+ ?2 T9 k/ c
22.         .Range("A1:E10") = "AutoCAD写入"
    
23.         arr = .Range("G3:G5")
    
24.         brr = .Range("G8:H11")
    / E5 N! I; |" A- @0 Q. \
25.     End With
    % W3 I: E* X  W% b" L
26.     With ThisDrawing
    8 j6 w  S0 ~7 K6 n
27.         Rem 方法一：发送命令形式画图
    . h2 m  [) V1 P1 }
28.         'Dim m%
    
29.         'For m = 1 To UBound(arr, 1)
    
30.         '   .SendCommand arr(m, 1)    '第三组数据第一个空格不能使得CAD默认执行上一次绘图命令，所以第二个圆没成功！
    7 \" {! ?( ?% ?$ o' ~2 |' W- f) m
31.         'Next
    
32.         
    ; {5 I% B0 m6 p! w
33.         Rem 方法二：直接使用代码画图
    
34.         Dim L As AcadLine, Cir As AcadCircle
    " h4 S2 z2 C  s7 j$ z
35.         Dim p01(2) As Double, p02(2) As Double
    
36.         Dim cnt(2) As Double, R As Double
    
37.         p01(0) = brr(1, 1): p01(1) = brr(2, 1): p01(2) = 0
    5 L/ i3 Z* x9 Q$ g8 V- X
38.         p02(0) = brr(3, 1): p02(1) = brr(4, 1): p02(2) = 0
    7 i3 y* Q* h1 G, k) h9 X
39.         cnt(0) = brr(3, 1): cnt(1) = brr(4, 1): R = brr(1, 2)
    2 b& f, L1 ~5 q, |' e* k) z' _
40.         With .ModelSpace
    : U3 S9 i  V' Q% B0 S/ |: W
41.             Set L = .AddLine(p01, p02)
    
42.             Update
    
43.             Set Cir = .AddCircle(cnt, R)
    # K- h) q8 d: i6 ]: S7 D3 U/ k
44.             Update
    # W# \( u) g4 O
45.         End With
    ! h/ o5 _3 d  D: @9 ^
46.         cnt(0) = brr(2, 2): cnt(1) = brr(3, 2): R = brr(4, 2)
    , h" `* ]7 D9 |. U1 ?
47.         Set Cir = .ModelSpace.AddCircle(cnt, R)
    3 R' D; o' w2 p! l3 A
48.         Update
    
49.     End With
    ( k; d1 ?3 K& W# L2 J& N
50.     'EWB.Save
    
51.     EWB.Close True    '关闭病保存Excel文档的修改
    ; C/ E, _6 P0 C# z8 G5 v7 `0 J
52.     ExcelApp.Quit    '关闭Excel进程
    4 c5 B5 |8 q% @
53.     Set ExcelApp = Nothing   '释放变量
    
54.     Set EWB = Nothing
    
55.     Set ESHT = Nothing
    # j( }5 z: A5 K/ l) k; {% K, k
56. End Sub
    7 P2 X3 ]! Q" x3 I/ G

复制代码

通过AutoCAD调用Excel数据绘图.zip (45.9 KB, 下载次数: 20)

2019-7-1 13:11 上传

点击文件名下载附件
同样有前期绑定和后期绑定的区别，你可以自己试着修改看看。。。。

woaishuijia

AutoCAD 的 VBA 工程有两种保存和加载方法：

第一种是作为全局工程保存为单独的 dvb 文档，就像楼主在 3 楼阐述的那样。这种工程是全局的，我们可以在任何时候把它加载到正在运行的 AutoCAD 进程中来，也可以在编辑任何一个 dwg 文档时使用其中的宏。

第二种是作为嵌入工程，保存在 dwg 文档中，就像 EXCEL 的 VBA 工程保存在 xls 或 xlsm 文档中一样。这种工程是包含在 dwg 文档中的，在打开这个文档时自动加载，并且只能在编辑这个文档时使用其中的宏。

打开 VBA 管理器，最上面的“图形”下拉列表中列出了在当前 AutoCAD 进程中已经打开的全部 dwg 文档。选择其中的一个文档，如果这个 dwg 文档中包含嵌入的 VBA 工程，“嵌入工程”文本框中会显示嵌入工程的名称；如果这个 dwg 文档没有嵌入 VBA 工程，在“图形”下拉列表下面的“嵌入工程”文本框中会显示“（无）”。此时，在下面的“工程”表格中选择一个已经加载的全局工程（没有的话可以点击旁边的“新建”按钮创建一个），再点击“嵌入”按钮，这个全局工程将被“复制”到 dwg 文档中成为它的嵌入工程。

一个 *.dwg 文档只能嵌入一个 VBA 工程。

嵌入工程随 dwg 文档一同保存，无论你在图形界面保存文档还是在 VBA 编辑器界面保存文档，被保存的都是整个 dwg 文档，包括其中的嵌入工程。

对于一个嵌入了 VBA 工程的 dwg 文档，在 VBA 管理器上点击“提取”按钮，将删除文档中的嵌入工程——当然，在删除之前，AutoCAD 会询问你是否将其保存为一个全局工程（单独的 dvb 文档）。

woaishuijia

AD、.GetObjectidString 方法（2010版新增）
以字符串形式返回对象的ID。
7 k( w' v. T9 i! |* ~( V语法
7 A: i3 ^: `3 z) c$ ?4 FRetVal = Object.GetObjectIdString(acadObject, bHex)
object
2 H6 ]# i3 z/ l  R2 ~( o* p               Utility
               使用该方法的对象。
acadObject
) d2 B! Q/ R5 V6 `8 ]/ a               Object[对象]; 仅用于输入
8 ]0 n2 l1 P8 ]) G+ v- R               要返回其对象ID的AutoCAD对象。
2 L5 K4 R$ }1 `2 D, N( P! s# KbHex
" v; L  D7 I4 v% F  w+ B               Boolean[布尔值]; 仅用于输入
9 B- K* m2 ?* n1 _3 }* s! a               确定对象ID是作为整数还是十六进制返回。
2 z( J! ~6 J1 t( W2 P( B               TRUE: 十六进制。
               FALSE: 十进制。
% F* k( P- Y* R1 G1 n/ pRetVal
               String[字符串]
' n8 A( Q3 j1 m; o  L, p               对象ID字符串。


- W+ F5 Q  d6 I8 _. O# n

kuangben8

# f5 o% U. X% ~- o, j6 [% P
关于创建图案填充的补充：(非常感谢woaishuijia老师的热心帮助，以下是老师的帮助文档+我的一点总结)

一、关于 AddHatch方法的参数

1、在2002版及以前，AutoCAD 只有图案填充，那时的AddHatch 方法只有三个参数，即 PatternType（图案类型）、PatternName（图案名称）和 Associativity（关联性）；到2004版，增加了渐变填充， AddHatch 方法就增加了第四个参数 HatchObjectType（填充对象类型）。

2、先说第四个参数 HatchObjectType（填充对象类型）

先说它的原因是它的值决定了第一个参数的用法。按我们通常的思维习惯，它本来应该是第一个参数，但由于是后增加的，所以排在了第四个。

这个参数为 AcHatchObjectType 枚举类型。如果使用变量，应这样声明

Dim ** As AcHatchObjectType

这个枚举共有两个值：

1、acHatchObject= 0（图案填充）:表示选择填充样式为图案填充!对应填充界面如下

2、acGradientObject= 1（渐变填充）:表示选择填充样式为渐变填充!对应填充界面如下

  x  \7 a  P  C  W6 P0 [! r
/ W, n5 S9 |0 s3 C2 P3 h5 u1 H

这个参数是可选的，默认值为 0（acHatchObject，图案填充）。

2 k+ ^& E+ o; _

3、再来说第一个参数 PatternType

在2002版及以前，没有第四个参数（只有图案填充），这个 PatternType 参数是 AcPatternType 枚举类型。2004版及以后，这个参数的类型就有了两种选择，即：如果第四个参数HatchObjectType（填充对象类型）的值是 acHatchObject = 0（图案填充）或省略，则这个 PatternType 参数就必须用 AcPatternType 枚举类型；如果第四个参数 HatchObjectType（填充对象类型）的值是acGradientObject = 1（渐变填充），则这个 PatternType 参数就必须用 AcGradientPatternType 枚举类型。

这个PatternType 参数的值决定着第二个参数 PatternName（图案名称）的用法，后面再说。先说这个参数两种枚举的值：

1）AcPatternType 枚举类型。如果使用变量，应这样声明

Dim ** As AcPatternType

这个枚举共有三个值：

acHatchPatternTypePreDefined = 0（预定义）:使用CAD自带的填充样式!

acHatchPatternTypeUserDefined = 1（用户定义）:此时CAD自带的填充样式不可选!

acHatchPatternTypeCustomDefined = 2（自定义）:此时CAD自带的填充样式不可选!

这三个值对应着图形界面“图案填充和渐变色”对话框中“图案填充”选项卡上的“类型（Y）”下拉列表（见图）。

2）AcGradientPatternType 枚举类型。如果使用变量，应这样声明

Dim ** As AcGradientPatternType

这个枚举共有两个值：

acPreDefinedGradient = 0（预定义）

acUserDefinedGradient = 1（用户定义）

第一个值容易理解；第二个值E文是这样说的：Definesa pattern based on property values. 翻译：基于属性值定义模式。比较费解。经多次尝试，出错的提示总是“尚未实现”，且图形界面“图案填充和渐变色”对话框中也没有对应的选项。猜想这是为 AutoCAD 为今后的渐变填充改进预留的，就是说这个枚举目前只能用 acPreDefinedGradient = 0（预定义）值。

4、第二个参数 PatternName（图案名称）

1）当第一个参数 PatternType 是 AcPatternType 枚举类型且其值为 acHatchPatternTypePreDefined = 0（预定义）时，图形界面“填充图案选项板”（见图）上的“ANSI”、“ISO”和“其它预定义”选项卡上的所有图案名称都可以用。

2）当第一个参数 PatternType 是 AcPatternType 枚举类型且其值为 acHatchPatternTypeUserDefined = 1（用户定义）时，本参数只能为"_U"。这个图案没有什么实际用处。所以 AcPatternType 枚举类型的值 acHatchPatternTypeUserDefined = 1（用户定义）我认为至少在当前阶段是多余的，也许随着 AutoCAD 的改进将来会有用吧?

3）当第一个参数 PatternType 是 AcPatternType 枚举类型且其值为 acHatchPatternTypeCustomDefined = 2（自定义）时，本参数应使用图形界面“填充图案选项板”上的“自定义”选项卡上的图案名称。我没自定义过填充图案，我的这个选项卡上也是一片空白，所以这个枚举值对我也是没有用的。

4）当第一个参数PatternType 是 AcGradientPatternType 枚举类型且其值为acPreDefinedGradient = 0（预定义）时，本参数为下列9个名称之一：

     1、"Linear"、2、"Cylinder"、3、"InvCylinder"、4、"Spherical"、5、"HemiSpherical"、6、"Curved"、7、"InvSpherical"、8、"InvHemiSpherical"、9、"InvCurved"    ，对应图案如下：

   

5、第三参数: Associativity(是否关联)   参考如上右图

Boolean[布尔值]; 仅用于输入,TRUE: 图案填充为关联的。

FALSE: 图案填充为不关联的。

作用：当填充图案的边界发生变化时,填充的图案是否自动适应边界的变化。

省略时默认是FALSE(不关联，即不勾选)。但是第三参数仍然要定义变量,可以不赋值。

综上，第一个参数就取 0，第二个参数根据第四个参数的值取现有的图案填充名称或渐变名称，第四个参数决定第二参数的选择是图案填充还是渐变填充，图案名称必须是符合第四参数指定的类型中的图案名称。
& i* i' d7 L% B7 r6 J& O
+ O' M+ d/ F; t, k; E

二、创建填充的步骤和要求

首先用 AddHatch 方法创建填充对象；紧接着用Hatch 对象的 AppendOuterLoop 方法明确外边界；如果填充内部有空白，还要用 AppendInnerLoop 方法添加内边界，有几个内边界就用几次。边界必须是封闭的。组成边界的多个图元之间必须是首尾相连的，换句话说，组成边界的多个图元之间不允许交叉，只允许且必须端点重合。

在实际测试中发现使用图案填充时,添加完外边界后刷新界面,然后添加内边界无效!但是渐变填充却没事!

内边界与外边界不许交叉，各个内边界之间也不许交叉。

内边界可以内部还有内边界，就是两个内边界“嵌套”组成环形。

内边界内部是否填充、嵌套的内边界怎样填充，可以用 Hatch 对象的 HatchStyle 属性（孤岛检测样式）来决定。可以在图形界面打开“特性”管理器，再选择一个有内边界的填充对象，在“特性”管理器中修改“孤岛检测样式”属性查看效果。

1. Sub AddHatch方法()
   
2.     Rem 语法:RetVal = Object.AddHatch(PatternType, PatternName, Associativity [, HatchObjectType])
   
3.     Dim HatchObject As AcadHatch            '定义填充图案对象
   # g1 N3 ^) {6 i
4.     Rem 定义填充类型为长整型，取值为图案填充的0,1,2；渐变填充的0,1，一般就取0(CAD预定义)
   : o/ Z$ {1 z$ u! n8 T+ y. r
5.     Dim hatchtype As AcPatternType       '参数4设置为图案填充的类型，参数4若是渐变填充，则定义为AcGradientPatternType类型
   
6.     '    Dim hatchtype As AcGradientPatternType
   
7.     Dim HatchName As String                   '定义图案名称为字符串类型
   - |  V: \, z, k) W3 x4 h% P3 z: k
8.     Dim HatchAssociativity As Boolean       '定义关联类型为布尔值，取值为True表示关联，False表示非关联。
   
9.     Dim HObjectType As AcHatchObjectType    '定义图案对象类型，取值为“图案填充-0”、“渐变填充-1”。省略默认为0.
   
10. 
    
11.     Rem 首先添加几个边界以备填充使用
    
12.     Dim L As AcadLWPolyline, cir1 As AcadCircle, cir2 As AcadCircle, CIR3 As AcadCircle   '定义一个多段线和三个圆
    
13.     Dim pts(11) As Double, P0(2) As Double, R As Double   '定义多段线端点变量，圆心变量，半径变量
    
14.     pts(0) = 0: pts(1) = 0: pts(2) = 20: pts(3) = 15: pts(4) = 10: pts(5) = 30
    8 C4 ?# b0 @$ ]3 a! Z' d
15.     pts(6) = 50: pts(7) = 50: pts(8) = 0: pts(9) = -70: pts(10) = -70: pts(11) = 32
    
16.     Set L = ThisDrawing.ModelSpace.AddLightWeightPolyline(pts)
    ( [) {' k* y, l! q0 O( I
17.     Update
    1 m% p6 ?( j9 y1 c) t8 }" S
18.     L.Closed = True   '将多段线闭合
    . Z4 T" a5 z8 b6 m+ g1 g4 R
19.     Update
    ' r, F4 x4 i8 v) [* Y
20.     P0(0) = 0: P0(1) = 0: P0(2) = 0
    
21.     R = 25
    , C) D1 w* u1 C
22.     Set cir1 = ThisDrawing.ModelSpace.AddCircle(P0, R)
    
23.     Update
    % k6 {& \' p% n* s
24.     R = 50
    
25.     Set cir2 = ThisDrawing.ModelSpace.AddCircle(P0, R)
    - F  g) j8 M; U" ^
26.     Update
    " m" V# }  {- Q# B  ^( L, ^
27.     R = 70
    
28.     Set CIR3 = ThisDrawing.ModelSpace.AddCircle(P0, R)
    . y$ j+ ~4 O( G  q2 ~3 L; {, _5 s
29.     Update
    . D/ a% A7 i1 g0 F$ x
30.    
    
31.     Rem 接下来赋值图案填充变量，先复制第四参数，再赋值第一参数、第二参数、第三参数
    
32.     HObjectType = 1   '写0也可以直接写acHatchObject，表示图案填充类型,都省略默认为0;写1也可以写成acGradientObject，表示渐变填充
      V( G- Z9 Z* ?6 P, S
33.     '    HObjectType = acGradientObject '也可以直接写1，表示渐变填充类型
    7 J6 ?8 [7 {6 n
34.     Rem 第一参数值英文名称太长，还是直接记住数字好了！
    5 J  }2 ?6 U# a' q8 F( ]# t
35.     hatchtype = 0       'acHatchPatternTypePreDefined,参数太长，直接记住数字吧！
    
36.     '    HatchType = 1      'acHatchPatternTypeUserDefined
    2 ]/ @3 Y( e7 S; [' C9 Z+ i
37.     '    HatchType = 2      'acHatchPatternTypeCustomDefined,第四参数为1时此参数无效！
    & B5 l& U/ R7 H# m1 Q. h7 X
38.     Rem 以下四类图案名称仅在第四参数=0时有效！每一类里有数个名称可用！
    
39.     '    HatchName = "ANSI32"
    ( r0 b: S- z4 @( ]
40.     '    HatchName = "ISO02W100"    '此处的名字到底是什么？
    
41.     '    HatchName = "AR-HBONE"
    ) j: b! v- [0 O' ?+ u) q# H% C
42.     '    HatchName = "STARS"
    ' C( O  R0 L7 Y4 }! ]% r' Z
43.     Rem  以下9种图案名称仅在第四参数=1时有效！表示渐变填充名称，只有这9个名称。
    , P( h. ~! u) T5 s* i+ b9 a
44.     '    HatchName = "Linear"               '对应第1行第1列图案
    * V) k# U& J9 I6 A, ?3 C% e
45.     '    HatchName = "Cylinder"             '对应第1行第2列图案
    
46.     '    HatchName = "InvCylinder"          '对应第1行第3列图案
    
47.     HatchName = "Spherical"            '对应第2行第1列图案
    
48.     '    HatchName = "HemiSpherical"        '对应第2行第2列图案
    
49.     '    HatchName = "Curved"               '对应第2行第3列图案
    8 N" v# ]/ M9 p: M7 U
50.     '    HatchName = "InvSpherical"         '对应第3行第1列图案
    
51.     '    HatchName = "InvHemiSpherical"     '对应第3行第2列图案
    
52.     '    HatchName = "InvCurved"            '对应第3行第3列图案
    
53.     Rem 第三参数一般设置为true(关联)
    ) h, J0 O$ D* [9 [% b2 c, s
54. '    HatchAssociativity = True        '省略赋值时默认为False
    
55.     '    HatchAssociativity = False
    1 O; p( t3 \5 l* a" e) _
56.    
    
57.     Rem 首先创建图案填充，然后创建图案外边界和内边界
    5 U2 c8 C, Q& O9 K2 \7 T
58.     Set HatchObject = ThisDrawing.ModelSpace.AddHatch(hatchtype, HatchName, HatchAssociativity, HObjectType)
    
59.     '    Set HatchObject = ThisDrawing.ModelSpace.AddHatch(0, "ANSI32", True, 0)   '也可以直接写参数值
    $ |" j7 N4 |1 W  x3 V2 G) Q( O$ {
60.     Dim OUTLOOP(0) As AcadEntity    '定义外边界为CAD实体类型
    
61.     Set OUTLOOP(0) = CIR3      '将cir1圆赋给外边界
    
62.     HatchObject.AppendOuterLoop (OUTLOOP)    '设置图案填充的外边界
    ( x7 }$ ~, {3 d* p- f+ Y$ t2 o
63.     Update   '添加内边界之前刷新界面，后续图案填充内边界添加无效！但是渐变填充可以！
    - E0 y) [9 F6 s4 a: t( N* h
64.     Dim INTLOOP(0) As AcadEntity    '定义内边界为CAD实体类型
    ; f2 g2 q. P* u! l( w
65.     Set INTLOOP(0) = cir2           '将cir2圆赋给第一个内边界,如果内边界比外边界大，则出错！
    
66.     HatchObject.AppendInnerLoop (INTLOOP)    '设置图案填充的内边界
    
67.     Update
    $ `3 S& ^/ H- W& s
68.     Set INTLOOP(0) = L           '将cir3圆赋给第二个内边界，同时设置两个内边界不好使！要一个一个设置
    / F' L6 z6 D1 \7 Y" n
69.     HatchObject.AppendInnerLoop (INTLOOP)    '设置图案填充的内边界
    
70.     Update
    
71. End Sub

复制代码

) E: C  m3 L5 _5 b, ]% C) _ 2.11.02、创建图案填充的补充.zip (11.2 KB, 下载次数: 6)

2019-4-14 10:11 上传

点击文件名下载附件

4 I" J- |, G, X# h; J0 t5 w7 J: l

wx_ykfxqQi4

很好很强大

chenmik

楼主很用心啊，顶一下！