图框里的自动编号

2017forverd

这是一个标准图框的边角，能否实现类似于word中的自动编号，其中第几页

按照图框的X坐标自动编号，共几页取按照X坐标排序的最大值，并且保存图纸时自动刷新，无需人为操作。

图框是外部参照。

dong20030432

肯定是可以自动填写的，代码也不复杂，就是过滤图框，计总数，按X坐标排序，再逐一写入页码即可。关键是这个程序的代码写在哪里更合适，如果写在本图，则其它图还要单独再导入一次代码。如果写在插件里面，肯定要有触发事件的。

2017forverd

dong20030432 发表于 2018-3-20 12:13
肯定是可以自动填写的，代码也不复杂，就是过滤图框，计总数，按X坐标排序，再逐一写入页码即可。关键是这 ...

能否把代码写到外部参照里，这样在引用外部参照的时候会不会触发事件？

dong20030432

引用过程好像不能触发事件吧?不了解。
可不可以屏蔽CAD关闭按钮（要用API)，要求用户用二次开发按钮进行关闭保存，这样就强制执行代码了。

wyy623

dong20030432 发表于 2018-3-20 12:13
肯定是可以自动填写的，代码也不复杂，就是过滤图框，计总数，按X坐标排序，再逐一写入页码即可。关键是这 ...

能不能给个范例呢~~~参考参考

dong20030432

wyy623 发表于 2018-6-5 17:36
能不能给个范例呢~~~参考参考

没有单独做过相同程序，从其它程序中摘录出一小段，比较凌乱，请参考！

2. 
   
3. ’部分声明
   
4. Public Type EntSse
   
5.     EntTem As AcadEntity
   
6.     X As Double
   
7.     Y As Double
   
8. End Type
   
9. Public tempObj() As EntSse
   
10. 
    
11. Sub 块过滤()
    
12. IsOpen = False
    
13. For Each acaddoc In acadapp.Documents
    
14. If StrComp(acaddoc.Name, MyFileName, vbTextCompare) = 0 Then
    
15. IsOpen = True
    
16. acaddoc.Activate
    
17. Exit For
    
18. End If
    
19. Next
    
20. If IsOpen = False Then acadapp.Documents.Open MyPath & MyFileName
    
21. acadapp.ZoomExtents
    
22. Set Sset = acadapp.ActiveDocument.SelectionSets.Add(Now & Timer)
    
23. CreateSSetFilter FilterType, FilterDate, 0, "insert"，2，“块名称”
    
24. Sset.Select acSelectionSetAll, , , FilterType, FilterDate
    
25. End Sub
    
26. 
    
27. '快速创建选择集
    
28. Public Sub CreateSSetFilter(ByRef FilterType As Variant, ByRef filterData As Variant, ParamArray filter())
    
29. If UBound(filter) Mod 2 = 0 Then
    
30. MsgBox "filter 参数无效！"
    
31. Exit Sub
    
32. End If
    
33. Dim fType() As Integer  '过滤器规则
    
34. Dim fData() As Variant  '过滤器参数
    
35. Dim Count As Integer
    
36. Count = (UBound(filter) + 1) / 2
    
37. ReDim fType(Count - 1)
    
38. ReDim fData(Count - 1)
    
39. Dim i As Integer
    
40. For i = 0 To Count - 1
    
41. fType(i) = filter(2 * i)
    
42. fData(i) = filter(2 * i + 1)
    
43. Next i
    
44. FilterType = fType
    
45. filterData = fData
    
46. End Sub
    
47. 
    
48. '选择集排序
    
49. Sub X坐标排序(ss As AcadSelectionSet)
    
50.     Dim i As Integer
    
51.     Dim j As Integer
    
52.     If ss.Count = 0 Then Exit Sub
    
53.     ReDim tempObj(ss.Count - 1)
    
54.     For i = LBound(tempObj) To UBound(tempObj)
    
55.         ss(i).GetBoundingBox pMin, pMax
    
56.         Set tempObj(i).EntTem = ss(i)
    
57.         tempObj(i).X = pMin(0)
    
58.         tempObj(i).Y = pMin(1)
    
59.     Next
    
60.     For i = 0 To UBound(tempObj) - 1
    
61.       For j = 1 To UBound(tempObj) - i
    
62.         If tempObj(j - 1).X > tempObj(j).X Then
    
63.               temp = tempObj(j - 1)
    
64.               tempObj(j - 1) = tempObj(j)
    
65.               tempObj(j) = temp
    
66.         End If
    
67.       Next
    
68.     Next
    
69. End Sub

<br /> ’部分声明<br /> Public Type EntSse<br />     EntTem As AcadEntity<br />     X As Double<br />     Y As Double<br /> End Type<br /> Public tempObj() As EntSse<br /> <br /> Sub 块过滤()<br /> IsOpen = False<br /> For Each acaddoc In acadapp.Documents<br /> If StrComp(acaddoc.Name, MyFileName, vbTextCompare) = 0 Then<br /> IsOpen = True<br /> acaddoc.Activate<br /> Exit For<br /> End If<br /> Next<br /> If IsOpen = False Then acadapp.Documents.Open MyPath & MyFileName<br /> acadapp.ZoomExtents<br /> Set Sset = acadapp.ActiveDocument.SelectionSets.Add(Now & Timer)<br /> CreateSSetFilter FilterType, FilterDate, 0, "insert"，2，“块名称”<br /> Sset.Select acSelectionSetAll, , , FilterType, FilterDate<br /> End Sub<br /> <br /> '快速创建选择集<br /> Public Sub CreateSSetFilter(ByRef FilterType As Variant, ByRef filterData As Variant, ParamArray filter())<br /> If UBound(filter) Mod 2 = 0 Then<br /> MsgBox "filter 参数无效！"<br /> Exit Sub<br /> End If<br /> Dim fType() As Integer  '过滤器规则<br /> Dim fData() As Variant  '过滤器参数<br /> Dim Count As Integer<br /> Count = (UBound(filter) + 1) / 2<br /> ReDim fType(Count - 1)<br /> ReDim fData(Count - 1)<br /> Dim i As Integer<br /> For i = 0 To Count - 1<br /> fType(i) = filter(2 * i)<br /> fData(i) = filter(2 * i + 1)<br /> Next i<br /> FilterType = fType<br /> filterData = fData<br /> End Sub<br /> <br /> '选择集排序<br /> Sub X坐标排序(ss As AcadSelectionSet)<br />     Dim i As Integer<br />     Dim j As Integer<br />     If ss.Count = 0 Then Exit Sub<br />     ReDim tempObj(ss.Count - 1)<br />     For i = LBound(tempObj) To UBound(tempObj)<br />         ss(i).GetBoundingBox pMin, pMax<br />         Set tempObj(i).EntTem = ss(i)<br />         tempObj(i).X = pMin(0)<br />         tempObj(i).Y = pMin(1)<br />     Next<br />     For i = 0 To UBound(tempObj) - 1<br />       For j = 1 To UBound(tempObj) - i<br />         If tempObj(j - 1).X > tempObj(j).X Then<br />               temp = tempObj(j - 1)<br />               tempObj(j - 1) = tempObj(j)<br />               tempObj(j) = temp<br />         End If<br />       Next<br />     Next<br /> End Sub

wyy623

dong20030432 发表于 2018-6-6 10:23
没有单独做过相同程序，从其它程序中摘录出一小段，比较凌乱，请参考！

非常感谢。。。

00放飞梦想00

wyy623 发表于 2018-6-6 18:30
非常感谢。。。

您好！这个码可以共享一下吗