坐标网格标注 vba

yealor

需求：  对坐标网格进行批量标注
cad版本：2016




Sub Start_WangGeZuoBiao()
   
    Dim Px As AcadEntity  'AcadObject ' AcadLine
    Dim PLX As AcadLine
   Dim PtPick As Variant
   

On Error GoTo Err_handle

     Do While ThisDrawing.SelectionSets.Count > 0   '选择集使用完了就要删除，图中原有的选择集
         ThisDrawing.SelectionSets.Item(0).Delete
     Loop

    Dim XuanZeji As AcadSelectionSet
    Set XuanZeji = ThisDrawing.SelectionSets.Add("XZJ") '添加选择集,选择集名为XZJ
    Dim ft(0) As Integer
    Dim fd(0) As Variant
    ft(0) = 0
    fd(0) = "Line"
    XuanZeji.SelectOnScreen ft, fd  '在屏幕上批量选择对象,但只选直线到选择集中

Dim JiaoDian As Variant
'''Dim Str As String

Dim Yi(0) As AcadEntity
'''Dim Yd(0) As AcadEntity
'''Dim tt As AcadEntity
Dim TXT As AcadText
  For Each Px In XuanZeji
    Set Yi(0) = Px
'''    Debug.Print Px.Handle
    XuanZeji.RemoveItems Yi  '在选择集中删掉本图元,减少自和自己比较有没有交点
    For Each PLX In XuanZeji
'''        Debug.Print PLX.Handle      '看看在和什么图元比较
        JiaoDian = Px.IntersectWith(PLX, acExtendNone)  '计算交点坐标
        If UBound(JiaoDian) > 0 Then                   '判断交点是否存在
                ThisDrawing.ModelSpace.AddText "N" & Format(JiaoDian(0), "0.000"), JiaoDian, 1
                Set TXT = ThisDrawing.ModelSpace.AddText("S" & Format(JiaoDian(1), "0.000"), JiaoDian, 1)
                TXT.Rotate JiaoDian, (270 * 3.14159265358979 / 180) '''弧度旋转
'''                Str = JiaoDian(0) & "," & JiaoDian(1)
'''                Debug.Print Str
'''                Set Yd(0) = PLX
'''                Debug.Print Px.Handle
''''                XuanZeji.RemoveItems Yi   '此处不能移除配对项，否则在循环过程中会出现跳过的现象
'''                    For Each tt In XuanZeji
'''                        Debug.Print tt.Handle
'''                    Next
               
                Exit For
        End If
    Next
  Next

Err_handle:
  
End Sub

陈宫在家吗

为什么我发表的回复，自己编辑了一下，就不见了？

'==================================

原来跑最上面去了……

陈宫在家吗

yealor 发表于 2022-12-22 16:46
天，我是12年注册的，今天居然才发第一个帖子

我也差不多，13年注册的，今天才发第2个帖子

myairen

我是15年注册的，今天居然才发第一个帖子

中国梦

谢谢楼主分享

lxl217114

谢谢大佬，大佬有空可以多发帖子

yealor

20060510412 发表于 2022-12-22 17:42
之前接触过一段时间的vba，了解一点皮毛。

想请教一个问题，VBA能引用外部文件中的子函数吗？

对于你的疑问，我不甚了解，抱歉，抱歉

20060510412

之前接触过一段时间的vba，了解一点皮毛。

想请教一个问题，VBA能引用外部文件中的子函数吗？

之前接触vba的时候，都是在当前代码中直接写一个子函数，好像是Private Function。

yealor

天，我是12年注册的，今天居然才发第一个帖子