求助各位大神

小百合

cad图如何批量等距、对齐排列，求大神，最好弄个个lisp

eachy

搜索 实体对齐

炫翔

思路:组码或者包围框对齐

小百合

找不到，有就直接发个上来吧

小百合

eachy 发表于 2013-6-15 21:19
搜索 实体对齐

只有这个错误的程序，能给我发个吗



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
- 本文出自晓东CAD家园-论坛，原文地址：http://www.xdcad.net/forum/thread-658405-1-1.html

eachy

小百合 发表于 2013-6-16 09:35
只有这个错误的程序，能给我发个吗

XD 工具箱中有这个功能