Chèn nhiều block có tên khác nhau từ excel

[sodien]

Em mới học VBA trong cad nên không giải quyết được bài toán chèn nhiều Block có tên khác nhau trong cad (trong cad đã tồn tại tên của những block đó. Nếu để tên của một block ở vị trí Nameblk thì chạy tố nhưng chuyển qua biến thì không chạy

Sub insertblock()
    Dim blk As AcadBlockReference
    Dim Nameblk As String
    Dim x1(0 To 2) As Double
    Dim AcadMo As AcadModelSpace
                x1(0) = Sheets("khaosat").Cells(i, 7)
                x1(1) = Sheets("khaosat").Cells(i, 8)
                x1(2) = 0

           Set blk = AcadMo.insertblock(x1, "Nameblk", 1#, 1#, 1#, 0)
end sub

 

[nvson]

Bạn thử đoạn code sau nhé:

Sub insertblock_GPE()
    Dim blk As AcadBlockReference
    Dim Nameblk As String
    Dim x1(0 To 2) As Double
    Dim i As Double
    'Dim AcadMo As AcadModelSpace
    
    i = 1
    
    Do While Not IsEmpty(Sheets("khaosat").Cells(i, 1))
        x1(0) = Sheets("khaosat").Cells(i, 1)
        x1(1) = Sheets("khaosat").Cells(i, 2)
        x1(2) = 0
        
        Nameblk = Sheets("khaosat").Cells(i, 3)
        
        Set blk = AcadApplication.ActiveDocument.ModelSpace.insertblock(x1, Nameblk, 1#, 1#, 1#, 0)
        i = i + 1
    Loop
[B][COLOR=#ff0000]Set blk = Nothing[/COLOR][/B]
End Sub

Cột A là tọa độ X, cột B là tọa độ Y, cột C là tên Block
Khi chạy bạn chú ý trong VBA Excel: Vào Tools/ Prefercences, rồi chọn "AutoCad xxxx Type Library"

 

[sodien]

Cám ơn bác đã bỏ thời gian ra để giúp em, em thử rồi đạt kết quả và đã phát hiện lỗi do tên block trong cad có khoảng trống ở giữa nên không thực hiện được

 

[sodien]

Xin hỏi bác nvson một chút nếu thêm cột D và E là value của 2 attributes thì cần thêm những gì để đưa các value vào các block cho đúng.Nếu trong cad không có block thì tạo block với 2 attributes.

Bạn thử đoạn code sau nhé:

Sub insertblock_GPE()
    Dim blk As AcadBlockReference
    Dim Nameblk As String
    Dim x1(0 To 2) As Double
    Dim i As Double
    'Dim AcadMo As AcadModelSpace
    
    i = 1
    
    Do While Not IsEmpty(Sheets("khaosat").Cells(i, 1))
        x1(0) = Sheets("khaosat").Cells(i, 1)
        x1(1) = Sheets("khaosat").Cells(i, 2)
        x1(2) = 0
        
        Nameblk = Sheets("khaosat").Cells(i, 3)
        
        Set blk = AcadApplication.ActiveDocument.ModelSpace.insertblock(x1, Nameblk, 1#, 1#, 1#, 0)
        i = i + 1
    Loop
[B][COLOR=#ff0000]Set blk = Nothing[/COLOR][/B]
End Sub

Cột A là tọa độ X, cột B là tọa độ Y, cột C là tên Block
Khi chạy bạn chú ý trong VBA Excel: Vào Tools/ Prefercences, rồi chọn "AutoCad xxxx Type Library"

 

[nvson]

Xin hỏi bác nvson một chút nếu thêm cột D và E là value của 2 attributes thì cần thêm những gì để đưa các value vào các block cho đúng.Nếu trong cad không có block thì tạo block với 2 attributes.

Ý bạn là Insert block thuộc tính phải không?
Bạn làm theo cách sau:

Sub insertblock_GPE()
    Dim blk As AcadBlockReference
    Dim Nameblk As String
    Dim x1(0 To 2) As Double
    Dim i As Double, x
    'Dim AcadMo As AcadModelSpace
    Dim varAtts() As AcadBlockReference
    
    i = 1
    
    Do While Not IsEmpty(Sheets("khaosat").Cells(i, 1))
        x1(0) = Sheets("khaosat").Cells(i, "A")
        x1(1) = Sheets("khaosat").Cells(i, "B")
        x1(2) = 0
        
        Nameblk = Sheets("khaosat").Cells(i, "C")
        
        Set blk = AcadApplication.ActiveDocument.ModelSpace.InsertBlock(x1, Nameblk, 1#, 1#, 1#, 0)
        
        varAtts = blockRefObj.GetAttributes
        For x = LBound(varAtts) To UBound(varAtts)
            Select Case varAtts(x).TagString
                Case "[COLOR=#ff0000][B]AAA[/B][/COLOR]"
                    varAtts(x).TextString = Sheets("khaosat").Cells(i, "D")
                Case "[B][COLOR=#ff0000]BBB[/COLOR][/B]"
                    varAtts(x).TextString = Sheets("khaosat").Cells(i, "E")
            End Select
        Next x
        blk.Update
        i = i + 1
    Loop
    
Set blk = Nothing
End Sub

Bạn chú ý thay chữ màu đỏ trong đoạn code trên cho đúng với tên thuộc tính của Block cần Insert.

 

[sodien]

cám ơn bac nvson, đoạn code trên đã hoạt động đúng ý đồ của em. Trước em cũng viết đoạn code từ select case nhưng chắc thiếu blk.update nên không được. đoạn code trên sửa lại ở đoạn varAtts = blockRefObj.GetAttributes thành varAtts = blk.GetAttributes là hoạt động tốt

 

[sonfa]

cám ơn bac nvson, đoạn code trên đã hoạt động đúng ý đồ của em. Trước em cũng viết đoạn code từ select case nhưng chắc thiếu blk.update nên không được. đoạn code trên sửa lại ở đoạn varAtts = blockRefObj.GetAttributes thành varAtts = blk.GetAttributes là hoạt động tốt

exexCho mình xin file excel và cad được không, mình làm tương tự mà không được, thanks

 

[authority]

Bạn thử đoạn code sau nhé:

Sub insertblock_GPE()
    Dim blk As AcadBlockReference
    Dim Nameblk As String
    Dim x1(0 To 2) As Double
    Dim i As Double
    'Dim AcadMo As AcadModelSpace
   
    i = 1
   
    Do While Not IsEmpty(Sheets("khaosat").Cells(i, 1))
        x1(0) = Sheets("khaosat").Cells(i, 1)
        x1(1) = Sheets("khaosat").Cells(i, 2)
        x1(2) = 0
       
        Nameblk = Sheets("khaosat").Cells(i, 3)
       
        Set blk = AcadApplication.ActiveDocument.ModelSpace.insertblock(x1, Nameblk, 1#, 1#, 1#, 0)
        i = i + 1
    Loop
[B][COLOR=#ff0000]Set blk = Nothing[/COLOR][/B]
End Sub

Cột A là tọa độ X, cột B là tọa độ Y, cột C là tên Block
Khi chạy bạn chú ý trong VBA Excel: Vào Tools/ Prefercences, rồi chọn "AutoCad xxxx Type Library"

Trường hợp block chưa có sẵn trong file mà lấy từ file "Thu vien" thì thêm thế nào Bác nhi?
em cảm ơn