社区 › VBA/VB/ActiveX/API 编程技术 › 图框里的自动编号

2017forverd 发表于 2018-3-20 11:16:48

图框里的自动编号

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

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

图框是外部参照。

dong20030432 发表于 2018-3-20 12:13:30

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

2017forverd 发表于 2018-3-20 15:03:58

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

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

dong20030432 发表于 2018-3-20 15:31:13

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

wyy623 发表于 2018-6-5 17:36:15

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

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

dong20030432 发表于 2018-6-6 10:23:53

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

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

’部分声明
Public Type EntSse
    EntTem As AcadEntity
    X As Double
    Y As Double
End Type
Public tempObj() As EntSse

Sub 块过滤()
IsOpen = False
For Each acaddoc In acadapp.Documents
If StrComp(acaddoc.Name, MyFileName, vbTextCompare) = 0 Then
IsOpen = True
acaddoc.Activate
Exit For
End If
Next
If IsOpen = False Then acadapp.Documents.Open MyPath & MyFileName
acadapp.ZoomExtents
Set Sset = acadapp.ActiveDocument.SelectionSets.Add(Now & Timer)
CreateSSetFilter FilterType, FilterDate, 0, "insert"，2，“块名称”
Sset.Select acSelectionSetAll, , , FilterType, FilterDate
End Sub

'快速创建选择集
Public Sub CreateSSetFilter(ByRef FilterType As Variant, ByRef filterData As Variant, ParamArray filter())
If UBound(filter) Mod 2 = 0 Then
MsgBox "filter 参数无效！"
Exit Sub
End If
Dim fType() As Integer'过滤器规则
Dim fData() As Variant'过滤器参数
Dim Count As Integer
Count = (UBound(filter) + 1) / 2
ReDim fType(Count - 1)
ReDim fData(Count - 1)
Dim i As Integer
For i = 0 To Count - 1
fType(i) = filter(2 * i)
fData(i) = filter(2 * i + 1)
Next i
FilterType = fType
filterData = fData
End Sub

'选择集排序
Sub X坐标排序(ss As AcadSelectionSet)
    Dim i As Integer
    Dim j As Integer
    If ss.Count = 0 Then Exit Sub
    ReDim tempObj(ss.Count - 1)
    For i = LBound(tempObj) To UBound(tempObj)
      ss(i).GetBoundingBox pMin, pMax
      Set tempObj(i).EntTem = ss(i)
      tempObj(i).X = pMin(0)
      tempObj(i).Y = pMin(1)
    Next
    For i = 0 To UBound(tempObj) - 1
      For j = 1 To UBound(tempObj) - i
      If tempObj(j - 1).X > tempObj(j).X Then
            temp = tempObj(j - 1)
            tempObj(j - 1) = tempObj(j)
            tempObj(j) = temp
      End If
      Next
    Next
End Sub

wyy623 发表于 2018-6-6 18:30:47

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

非常感谢。。。

00放飞梦想00 发表于 2022-6-4 11:21:50

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

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

查看完整版本: 图框里的自动编号