[编程申请]：块等距分布

snsj

现在几个块在一条直线上，但是块与块之间的距离不相等
申请：
点选第一个初始块，再点击最后一个末块，然后选中这几个块后，这几个快能以第一个块为始，最后一个块为终等距离分布

snsj

最终效果

yi.gao

命令divide有等距分布图块的功能，不知道它是否满足你的要求。

efan2000

Divide命令仅对线类有用吧。
下面的程序应该可以实现。

2. 
   
3.   [FONT=courier new]
   
4. 
   
5. Sub DivideBlock()
   
6.     On Error GoTo ErrTrap
   
7.     Dim StartEntObj As AcadEntity
   
8.     Dim pPt As Variant
   
9.     ThisDrawing.Utility.GetEntity StartEntObj, pPt, "请选择第一个对象: "
   
10.     Dim EndEntObj As AcadEntity
    
11.     ThisDrawing.Utility.GetEntity EndEntObj, pPt, "请选择最后一个对象: "
    
12.     If StartEntObj.ObjectName <> "AcDbBlockReference" Or StartEntObj.ObjectName <> EndEntObj.ObjectName Then
    
13.         ThisDrawing.Utility.Prompt "您选择的不是块! "
    
14.         Exit Sub
    
15.     End If
    
16.     Dim SSetObj As AcadSelectionSet
    
17.     Set SSetObj = ThisDrawing.SelectionSets.Add("DivideBlock")
    
18.     SSetObj.SelectOnScreen
    
19.     If SSetObj.Count = 0 Then Exit Sub
    
20.     '计算块与块之间的间距
    
21.     Dim Dist As Double
    
22.     Dist = CalcDistance(StartEntObj.InsertionPoint, EndEntObj.InsertionPoint) / (SSetObj.Count + 1)
    
23.     '计算块分布的角度
    
24.     Dim Ang As Double
    
25.     Ang = ThisDrawing.Utility.AngleFromXAxis(StartEntObj.InsertionPoint, EndEntObj.InsertionPoint)
    
26.     Dim i As Integer
    
27.     For i = 0 To SSetObj.Count - 1
    
28.         SSetObj(i).InsertionPoint = ThisDrawing.Utility.PolarPoint(StartEntObj.InsertionPoint, Ang, Dist * (i + 1))
    
29.     Next
    
30.     SSetObj.Delete
    
31.     Set SSetObj = Nothing
    
32.     Exit Sub
    
33. ErrTrap:
    
34.     If ThisDrawing.GetVariable("errno") = 7 Then Resume
    
35.     On Error GoTo 0
    
36. End Sub
    
37. 
    
38. '计算距离
    
39. Public Function CalcDistance(ByVal Pt1 As Variant, Optional ByVal Pt2 As Variant) As Double
    
40.     CalcDistance = 0
    
41.     Dim dX As Double
    
42.     Dim dY As Double
    
43.     Dim dZ As Double
    
44.    
    
45.     On Error GoTo ErrTrap
    
46.     dX = Pt2(0) - Pt1(0)
    
47.     dY = Pt2(1) - Pt1(1)
    
48.     dZ = Pt2(2) - Pt1(2)
    
49.     CalcDistance = Sqr(dX ^ 2 + dY ^ 2 + dY ^ 2)
    
50.     Exit Function
    
51. 
    
52. ErrTrap:
    
53.     On Error GoTo 0
    
54. End Function
    
55. 
    
56.   [/FONT]
    

<br />   [FONT=courier new]<br /> <br /> Sub DivideBlock()<br />     On Error GoTo ErrTrap<br />     Dim StartEntObj As AcadEntity<br />     Dim pPt As Variant<br />     ThisDrawing.Utility.GetEntity StartEntObj, pPt, "请选择第一个对象: "<br />     Dim EndEntObj As AcadEntity<br />     ThisDrawing.Utility.GetEntity EndEntObj, pPt, "请选择最后一个对象: "<br />     If StartEntObj.ObjectName <> "AcDbBlockReference" Or StartEntObj.ObjectName <> EndEntObj.ObjectName Then<br />         ThisDrawing.Utility.Prompt "您选择的不是块! "<br />         Exit Sub<br />     End If<br />     Dim SSetObj As AcadSelectionSet<br />     Set SSetObj = ThisDrawing.SelectionSets.Add("DivideBlock")<br />     SSetObj.SelectOnScreen<br />     If SSetObj.Count = 0 Then Exit Sub<br />     '计算块与块之间的间距<br />     Dim Dist As Double<br />     Dist = CalcDistance(StartEntObj.InsertionPoint, EndEntObj.InsertionPoint) / (SSetObj.Count + 1)<br />     '计算块分布的角度<br />     Dim Ang As Double<br />     Ang = ThisDrawing.Utility.AngleFromXAxis(StartEntObj.InsertionPoint, EndEntObj.InsertionPoint)<br />     Dim i As Integer<br />     For i = 0 To SSetObj.Count - 1<br />         SSetObj(i).InsertionPoint = ThisDrawing.Utility.PolarPoint(StartEntObj.InsertionPoint, Ang, Dist * (i + 1))<br />     Next<br />     SSetObj.Delete<br />     Set SSetObj = Nothing<br />     Exit Sub<br /> ErrTrap:<br />     If ThisDrawing.GetVariable("errno") = 7 Then Resume<br />     On Error GoTo 0<br /> End Sub<br /> <br /> '计算距离<br /> Public Function CalcDistance(ByVal Pt1 As Variant, Optional ByVal Pt2 As Variant) As Double<br />     CalcDistance = 0<br />     Dim dX As Double<br />     Dim dY As Double<br />     Dim dZ As Double<br />     <br />     On Error GoTo ErrTrap<br />     dX = Pt2(0) - Pt1(0)<br />     dY = Pt2(1) - Pt1(1)<br />     dZ = Pt2(2) - Pt1(2)<br />     CalcDistance = Sqr(dX ^ 2 + dY ^ 2 + dY ^ 2)<br />     Exit Function<br /> <br /> ErrTrap:<br />     On Error GoTo 0<br /> End Function<br /> <br />   [/FONT]<br />

yi.gao

divide命令是沿着指定对象等距排列点或块，指定对象必须是线性的，如直线、圆弧、多段线、样条线等，但排列的对象可以是非线性的，如点、图块等。我没明白efan2000兄指的“仅对线类有用”是什么，望商榷！

snsj

我明白YI.GAO的等分块的意思，不过会麻烦点，况且已经有的块不想删除掉了：）

efan2000

就是说必须要首先指定线类的对象，然后对其等分，并根据等分后的点的位置进行操作，所以实现步骤繁长。

snsj

说得对，现在就是想避开繁琐和线性的限制，根据初始块和末块实现块间距等分：）