AutoCAD VBA对齐对象

AutoCAD VBA对齐对象,代码如下。

Sub AlignEnt()
Dim ss As AcadSelectionSet
Set ss = CreateSelectionSet
ss.SelectOnScreen
Dim ent As AcadEntity
Dim MinPoint As Variant
Dim MaxPoint As Variant
If ss.Count > 0 Then
Dim AlignMode As String
On Error Resume Next
ThisDrawing.Utility.InitializeUserInput 0, "Left Middle Right"
AlignMode = ThisDrawing.Utility.GetKeyword("选择对齐方式[左对齐(L)/对中(M)/右对齐(R)]<左对齐>:")
If Err Then AlignMode = "Left"
If AlignMode = "" Then AlignMode = "Left"
Dim AlignPoint As Variant
Dim MovePoint(2) As Double
AlignPoint = ThisDrawing.Utility.GetPoint(, "请选择对起点:")
For Each ent In ss
ent.GetBoundingBox MinPoint, MaxPoint
Select Case AlignMode
Case "Left"
MovePoint(0) = MinPoint(0)
MovePoint(1) = AlignPoint(2)
MovePoint(2) = MinPoint(2)
Case "Middle"
MovePoint(0) = (MinPoint(0) + MaxPoint(0)) / 2
MovePoint(1) = AlignPoint(1)
MovePoint(2) = MinPoint(2)
Case "Right"
MovePoint(0) = MaxPoint(0)
MovePoint(1) = AlignPoint(1)
MovePoint(2) = MaxPoint(2)
End Select
ent.Move MovePoint, AlignPoint
Update
Next
Else
ThisDrawing.Utility.Prompt vbCr & "未选定对象,自动退出……"
End If
End Sub
Public Function CreateSelectionSet(Optional ssName As String = "ss") As AcadSelectionSet
Dim ss As AcadSelectionSet
On Error Resume Next
Set ss = ThisDrawing.SelectionSets(ssName)
If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
ss.Clear
Set creatselectionset = ss
End Function

代码完。

运行时提示“对象变量或with块变量未设置”。

作者:codee
文章千古事,得失寸心知。


原文地址:https://www.cnblogs.com/bimgoo/p/2502928.html