[求助]：各位老大麻烦帮我看看我以前下的xdcad的实体对齐源码要用什么命令启动另外要

xlmx-whj

各位老大麻烦帮我看看我以前下的xdcad的实体对齐源码要用什么命令启动另外要把它转成什么格式是lsp‘vlx，还是vba的

我在1例题的基础上修改的，绝对好用
'--------------------------------------------------------------------------------------------
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 Up Down"
AlignMode = ThisDrawing.Utility.GetKeyword("选择对齐方式[左对齐(L)/对中(M)/右对齐(R)/上对齐(U)/下对齐(D)]/<左对齐>:")

'如果用户直接按下Enter键
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(1)
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)
Case "Up"
MovePoint(0) = AlignPoint(0)
MovePoint(1) = MaxPoint(1)
MovePoint(2) = MaxPoint(2)
Case "Down"
MovePoint(0) = AlignPoint(0)
MovePoint(1) = MinPoint(1)
MovePoint(2) = MinPoint(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 CreateSelectionSet = ss
End Function

kmdz

vb的，程序不全。

xlmx-whj

哦！怪不得我用什么格式加载都没用也不知启动命令是什么看来没戏了