Vẽ đường tròn bám theo 1 Polyline

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài

nguyenvanvien

Thành viên mới
Tham gia
28/9/06
Bài viết
30
Được thích
43
Tôi có viết 1 CT nhưng báo lỗi, các bạn giúp sửa lại dùm :
Từ môi trường excel, chương trình sẽ lấy giá trị tại ô A1, sau đó sẽ chuyển qua AutoCAD, chương trình yêu cầu chọn 1 Polyline, sau khi người dùng chọn Polyline thì chương trình sẽ vẽ các đường tròn bán kính bằng ô B1 theo phương của đường Polyline.
Ví dụ cụ thể : Có 1 Polyline có tọa độ như sau:
A(0,0); B(200,200); C(400,200), giá trị ô A1 là 5, giá trị ô B1 là 3 thì chương trình sẽ vẽ 5 đường tròn bán kính bằng 3 nằm đều trên Polyline. 1 đường tròn tại A(0,0), 1 đường tròn tại C(400,200), còn lại ở giữa có 3 đường tròn
Tuy nhiên chương trình bị báo lỗi tại dòng ptArray = pline.GetPointAtDist(dist) ' LaY TOA DO DIEM TU KHOANG CACH
Mã:
Option Explicit

Sub DrawCirclesAlongPolyline()
    Dim acadApp As Object
    Dim acadDoc As Object
    Dim pline As Object
    Dim ptArray As Variant
    Dim i As Integer
    Dim Ban_kinh As Double
    Dim SLDuong_tron As Integer
    Dim CDDuong_thang As Double
    Dim KCDt_Dt As Double
    Dim dist As Double
    Dim pt As Variant
    Dim acadCircle As Object
    
    ' Lay du lieu tu Excel
    SLDuong_tron = Range("A1").Value
    Ban_kinh = Range("B1").Value

    ' Kiem tra
    If SLDuong_tron < 2 Then
        MsgBox "So luong duong tron pha >= 2", vbCritical, "L?i"
        Exit Sub
    End If
    
    If Ban_kinh <= 0 Then
        MsgBox "Ban kinh duong tron phai > 0", vbCritical, "L?i"
        Exit Sub
    End If

    ' Ket noi AutoCAD
    On Error Resume Next
    Set acadApp = GetObject(, "AutoCAD.Application") ' Kiem tra xem AutoCAD có chay khong
    If acadApp Is Nothing Then
        Set acadApp = CreateObject("AutoCAD.Application") ' Neu chua chay thi mo AutoCAD
    End If
    acadApp.Visible = True ' Hien thi AutoCAD
    On Error GoTo 0
    
    ' Mo ban ve hien tai
    Set acadDoc = acadApp.ActiveDocument

    ' Yeu cau nguoi dung chon 1 Polyline
    MsgBox "Vui lòng ch?n m?t Polyline trong AutoCAD.", vbInformation, "Hu?ng d?n"
    acadDoc.Utility.GetEntity pline, pt, "Chon mot Polyline: "

    ' Kiem tra co phai Polyline không
    If pline.ObjectName <> "AcDbPolyline" Then
        MsgBox "Doi tuong khong phai là Polyline!", vbCritical, "Loi"
        Exit Sub
    End If

    ' Lay tong chieu dai Polyline
    CDDuong_thang = pline.Length

    ' Tính khoang cach giua cac duong tron
    KCDt_Dt = CDDuong_thang / (SLDuong_tron - 1)

    ' Ve duong tron tren Polyline
    For i = 0 To SLDuong_tron - 1
        dist = i * KCDt_Dt ' Khoang cach tu diem dau
        ptArray = pline.GetPointAtDist(dist) ' LaY TOA DO DIEM TU KHOANG CACH
        ptArray = pline.get

        ' Ve duong tron tai toa do xac dinh
        Set acadCircle = acadDoc.ModelSpace.AddCircle(ptArray, Ban_kinh)
        acadCircle.Update
    Next i

    
    
End Sub
 

File đính kèm

Trong Autocad VBA không có GetPointAtDist nha bạn.
Với nếu polyline gấp khúc hoặc chứa cung tròng thì sao ?
 
Web KT

Bài viết mới nhất

Back
Top Bottom