Chuyển đến nội dung
Diễn đàn CADViet
dinhvantrang

VBA cho AutoCad-Hãy cùng tham gia trao đổi

Các bài được khuyến nghị

Mình có một công trình thực tế như sau, mong tất cả mọi người cùng hợp tác. Đó là thống kê khối lượng trên bản vẽ dùng VBA kết hợp giữa Cad và Exel. Tức là mình lấy dữ liệu từ bản vẽ Cad xong qua exel.

 

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Mình có một công trình thực tế như sau, mong tất cả mọi người cùng hợp tác. Đó là thống kê khối lượng trên bản vẽ dùng VBA kết hợp giữa Cad và Exel. Tức là mình lấy dữ liệu từ bản vẽ Cad xong qua exel.

Rồi sao nữa bác?

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Mình đã kiểm nghiệm như bạn nói.Đúng là với VBA chúng ta phải chọn đối tượng sau khi gõ lệnh.

Nhìn bạn minh họa với Autolisp và VBA, có vẻ VBA dài dòng quá nhỉ trong khi đó Lisp chỉ vài dòng là ok ngay.

Haizzzzaaa!

 

Một ông con đẻ, một ông con nuôi mà :). Nếu VBA còn được hỗ trợ thì tốt, nhưng đã ngừng từ AutoCad 2010 thì phải.

Anh cũng là người đam mê món này nhỉ :)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Một ông con đẻ, một ông con nuôi mà :). Nếu VBA còn được hỗ trợ thì tốt, nhưng đã ngừng từ AutoCad 2010 thì phải.

Anh cũng là người đam mê món này nhỉ :)

Yes bác, từ đời cad 2010 nó đã tách riêng thằng VBA ra chắc cho nhẹ gánh, ai thích xài VBA thì cài thêm module tương ứng vào.

 Được cái liên kết giữa Autocad và Excel ổn nên cũng không đến nỗi lắm.

P/S: Em chắc nhỏ tuổi hơn bác nhiều ạ

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Yes bác, từ đời cad 2010 nó đã tách riêng thằng VBA ra chắc cho nhẹ gánh, ai thích xài VBA thì cài thêm module tương ứng vào.

 Được cái liên kết giữa Autocad và Excel ổn nên cũng không đến nỗi lắm.

P/S: Em chắc nhỏ tuổi hơn bác nhiều ạ

 

Tôi là người mày mò, phát triển VBA, VB6 for Office và AutoCad. Thời ban đầu hơi cực vì tài liệu chả có, Internet cũng hạn chế. Giờ thì nhiều tài liệu, help cũng ổn. Các bạn trẻ đam mê mà nghiên cứu thì nhanh lên tay.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Mình có phần Insert block như bên dưới khi tạo optionbuttom1 thì insert lên cad ok . Nhưng khi mình tạo thêm optionbuttom2 . Mình copy phần 1 và chỉ đổi tên nó vẫn load lên listbox dữ liệu nhưng lại ko insert ra cad được . Xin mọi người giúp đỡ

Option Explicit
Const strfolderPath1 As String = "E:\NASOKA"
Const strfolderPath As String = "E:\BLOCK INSERT\"

Private Sub cmdcancel_Click()
 Unload Ussinsertblock
End Sub

Private Sub Cmdinsert_Click()

Dim objBlock As AcadBlockReference
Dim VarPiont As Variant
Dim strBlockname As String
Dim objBlock1 As AcadBlockReference
Dim VarPiont1 As Variant
Dim strBlockname1 As String
strBlockname = Ussinsertblock.Lstblockname.Value
strBlockname1 = Ussinsertblock.Lstblockname.Value

On Error GoTo Exitsud
VarPiont = ThisDrawing.Utility.GetPoint(, "pick piont to insert Block")
VarPiont1 = ThisDrawing.Utility.GetPoint(, "pick piont to insert Block")
Set objBlock = ThisDrawing.ModelSpace.InsertBlock(VarPiont, strfolderPath & strBlockname, 1, 1, 1, 0)
Set objBlock1 = ThisDrawing.ModelSpace.InsertBlock(VarPiont1, strfolderPath1 & strBlockname1, 1, 1, 1, 0)
Exitsud:
  Err.Clear
End Sub

Private Sub Frame2_Click()

End Sub

Private Sub Lstblockname_Click()

End Sub


Private Sub OptionButton1_Click()
Call UserForm_Initialize
End Sub

Private Sub OptionButton2_Click()
Call nasoka
End Sub

Private Sub UserForm_Initialize()
Dim FSO As New Scripting.FileSystemObject
Dim objFolder As Folder
Dim objfile As File

Set objFolder = FSO.GetFolder(strfolderPath)

Ussinsertblock.Lstblockname.Clear

For Each objfile In objFolder.Files
If UCase(FSO.GetExtensionName(objfile.Path)) = "DWG" Then
  Ussinsertblock.Lstblockname.AddItem objfile.Name
  End If
Next
End Sub

Private Sub nasoka()
Dim FSO1 As New Scripting.FileSystemObject
Dim objFolder1 As Folder
Dim objfile1 As File

Set objFolder1 = FSO1.GetFolder(strfolderPath1)

Ussinsertblock.Lstblockname.Clear

For Each objfile1 In objFolder1.Files
If UCase(FSO1.GetExtensionName(objfile1.Path)) = "DWG" Then
  Ussinsertblock.Lstblockname.AddItem objfile1.Name
  End If
Next
End Sub

 

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Mình thấy trong Lisp có hàm ssget ( chọn đối tượng ) --> trong vba không có --> mình thử xây dựng 1 hàm gần giống như kiểu ssget  như sau :

Sub ssget()
    Dim ssetObj As AcadSelectionSet
    Dim entity As AcadEntity
        Set ssetObj = ThisDrawing.PickfirstSelectionSet
        If ssetObj.Count Then
            ...........................
        Else
            Set ssetObj = ThisDrawing.SelectionSets.Add("#")
            If Err <> 0 Then
               Set ssetObj = ThisDrawing.SelectionSets("#"): ssetObj.Clear
            End If
        ssetObj.SelectOnScreen
        ...............................
End Sub

Nếu mà code trên chạy trong môi trường vba thì không vấn đề gì : * thuộc tính pickfirstSelectionset hoạt động bình thường

nhưng nếu ta thử gọi macro trên bằng lisp thì thuộc tính pickfristSelectionset không thể hoạt động : hàm báo lỗi nil 

(defun C:6()
      (command "-vbarun" "ssget")
)

---> Mình vẫn chưa tìm ra được nguyên nhân và cách khắc phục, mong các bạn yêu thích vba trong autocad chia sẻ ,trao đổi thêm về vấn để trên !

thanks! <----------- cảm ơn mọi người đã dành thời gian đọc bài viết của mình 

Bạn thiếu tên moldun trong lisp gọi lệnh của lisp ấy mà :))

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

em bị lỗi "AutoCAD VBA in not currently installed. Please run the AutoCAD R2016 installer toinstall the AUtoCAD VBA Component.", ai bị lỗi này rồi thì giúp giùm ạ

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
15 giờ trước, vinh19291 đã nói:

em bị lỗi "AutoCAD VBA in not currently installed. Please run the AutoCAD R2016 installer toinstall the AUtoCAD VBA Component.", ai bị lỗi này rồi thì giúp giùm ạ

Bạn tải Module VBA Enabler 2016 về và cài đặt nhé. Nhớ tắt Autocad trước khi cài đặt.

 

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Mình có đoạn code này, mình quét chọn đối tượng trên bản vẽ sau đó lọc ra các đối tượng là dimension. Mình muốn lấy tọa độ ExtLinePoint của Dimension để xử lý, mà không hiểu sao mình không lấy được. Có bạn nào giúp mình sửa lại đoạn code với. Cái đoạn trong dấu ngoặc í. Mình cám ơn nhiều.

 

Sub checkkichthuoclo()

Dim obs1 As AcadSelectionSet
Dim object1 As Variant
Dim dimaligned1 As AcadDimAligned
Dim point As Variant

 

On Error Resume Next
Set obs1 = ThisDrawing.SelectionSets("Myss")
If Err Then
Err.Clear
Set obs1 = ThisDrawing.SelectionSets.Add("Myss")
Else
obs1.Clear
End If
obs1.SelectOnScreen

 

(

    For Each object1 In obs1
    If object1.ObjectName = "AcDbRotatedDimension" Then
    Set dimaligned1 = object1
    point = dimaligned1.ExtLine1Point
    MsgBox point(0)
    Else: End If
    Next

)


End Sub

 

 

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
5 giờ trước, Bùi Mạnh Hùng đã nói:

Mình có đoạn code này, mình quét chọn đối tượng trên bản vẽ sau đó lọc ra các đối tượng là dimension. Mình muốn lấy tọa độ ExtLinePoint của Dimension để xử lý, mà không hiểu sao mình không lấy được. Có bạn nào giúp mình sửa lại đoạn code với. Cái đoạn trong dấu ngoặc í. Mình cám ơn nhiều.

 

Sub checkkichthuoclo()

Dim obs1 As AcadSelectionSet
Dim object1 As Variant
Dim dimaligned1 As AcadDimAligned
Dim point As Variant

 

On Error Resume Next
Set obs1 = ThisDrawing.SelectionSets("Myss")
If Err Then
Err.Clear
Set obs1 = ThisDrawing.SelectionSets.Add("Myss")
Else
obs1.Clear
End If
obs1.SelectOnScreen

 

(

    For Each object1 In obs1
    If object1.ObjectName = "AcDbRotatedDimension" Then
    Set dimaligned1 = object1
    point = dimaligned1.ExtLine1Point
    MsgBox point(0)
    Else: End If
    Next

)


End Sub

 

 

Thay thế dòng:

If object1.ObjectName = "AcDbRotatedDimension" Then

bằng :

If object1.ObjectName = "AcDbAlignedDimension" Then

  • Like 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Cám ơn bạn gia_bach nha.

Nhưng mà  "AcDbRotatedDimension" mới đúng á bạn. Mình thử rồi, điều kiện đó đúng rồi, nó đã chạy được vào trong lệnh If rồi, chỉ có điều là k lấy được ExtLinePoint ra, kể cả những thuộc tính khác của đường dimesion. Không hiểu tại sao. Bạn giúp mình lần nữa dc k.

image.png.9f785da81b7006117244acf8893e51f5.png

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Khai báo là:

Dim dimaligned1 As AcadDimAligned

ObjectName là "AcDbRotatedDimension"

thì làm sao chạy đúng được

 

  • Like 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Cám ơn bạn ndtnv

Như vậy là đúng á bạn, mình cũng có trả lời bạn gia_bach ở bên trên rồi, bạn đọc lại xem.

Mình cũng thử sửa lại là AcDbAlignedDimension rồi, phải là AcDbRotatedDimension nó mới đúng được điều kiện của lệnh If, cái AcDbRotatedDimension không gặp vấn đề gì cả. Nó chỉ không chạy được ở đoạn lấy cái điểm ExtLinePoint thôi.

Cám ơn bạn nha, có gì nghiên cứu giúp mình tiếp.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

×