Viết code vba

[Viết code vba]

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

[Tạo tuyến và Surface trong Autocad bằng VBA]

Xin chào các bạn!

Mình đang tìm hiểu về tạo tuyến và Surface trên AutoCAD bằng VBA. Mọi người có ai có ví dụ hay tài liệu cho mình xin với. Xin chân thành cảm ơn!

[Add Linetype mới có Shape trực tiếp lên bản vẽ]

Xin chào tất cả các bạn!

Mình làm bên trắc địa, có một số LineType cần tạo mới, dùng cả Shape file để tạo các file LIN mới. Nhưng khi coppy qua các máy khác thì phải coppy cả các Shape File và các Linetype này, rất bất tiện. 

Xin chỉ cho mình các Add các Linetype và Shape này vào ngay trong bản vẽ để khi coppy bản vẽ này thì sẽ có luôn các linetype này luôn. 

Chân thành cảm ơn tất cả các bạn!