Viết code vba

[soledas 0]

mình có các hình tròn có đường kính khác nhau 12,14,16,20,30 mình cần đếm được số lượng đường tròn và ghi text vào bản vẽ tương ứng với đường kính của đường nhờ các bạn viết dùm đoạn code vba

[namds86 6]

12 phút trước, soledas đã nói:

mình có các hình tròn có đường kính khác nhau 12,14,16,20,30 mình cần đếm được số lượng đường tròn và ghi text vào bản vẽ tương ứng với đường kính của đường nhờ các bạn viết dùm đoạn code vba

Không phải VBA được không bạn, viết bình thường thôi!

[doantrinh86 2]

Sub CountCircle()
   Dim objSS As AcadSelectionSet
   Dim objCircle() As AcadCircle
   Dim intCode(0) As Integer
   Dim varCode(0) As Variant
   
   intCode(0) = 0: varCode(0) = "CIRCLE"
   On Error GoTo ESCPress
   Set objSS = ThisDrawing.SelectionSets.Add(Now)
   
   objSS.SelectOnScreen intCode, varCode
   If objSS.Count = 0 Then
        MsgBox "No have circle on the drawing"
        objSS.Delete: End
    Else
        Dim strTextRadius As AcadText
        Dim i As Integer
        ReDim objCircle(objSS.Count - 1)
        For i = 0 To objSS.Count - 1
            Set objCircle(i) = objSS.Item(i)
            ThisDrawing.ModelSpace.AddText Round(objCircle(i).radius, 3), objCircle(i).Center, 2
        Next
        MsgBox "Have" & objSS.Count & " circle on the drawing "
   End If

   objSS.Delete
ESCPress:
   Err.Clear
End Sub

[soledas 0]

Vào lúc 11/10/2022 tại 22:53, doantrinh86 đã nói:

Sub CountCircle()
   Dim objSS As AcadSelectionSet
   Dim objCircle() As AcadCircle
   Dim intCode(0) As Integer
   Dim varCode(0) As Variant
   
   intCode(0) = 0: varCode(0) = "CIRCLE"
   On Error GoTo ESCPress
   Set objSS = ThisDrawing.SelectionSets.Add(Now)
   
   objSS.SelectOnScreen intCode, varCode
   If objSS.Count = 0 Then
        MsgBox "No have circle on the drawing"
        objSS.Delete: End
    Else
        Dim strTextRadius As AcadText
        Dim i As Integer
        ReDim objCircle(objSS.Count - 1)
        For i = 0 To objSS.Count - 1
            Set objCircle(i) = objSS.Item(i)
            ThisDrawing.ModelSpace.AddText Round(objCircle(i).radius, 3), objCircle(i).Center, 2
        Next
        MsgBox "Have" & objSS.Count & " circle on the drawing "
   End If

   objSS.Delete
ESCPress:
   Err.Clear
End Sub

Cảm ơn bạn nhé!

[CadExTools 100]

@doantrinh86 thấy style code quen quen!