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

[quancd 0]

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.

 

[dinhvantrang 151]

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?

[phantuhuong 226]

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ỉ :)

[dinhvantrang 151]

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 ạ

[phantuhuong 226]

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.

[ngocvuong84 0]

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

 

[VBA Dat Nguyen 0]

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à :))

[vinh19291 0]

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 ạ

[CadExTools 105]

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.

 

[phantuhuong 226]

Hy sớm có đầu sách VBA for AutoCAD cho các bạn đam mê phát triển.

[Bùi Mạnh Hùng 0]

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

 

 

[gia_bach 1555]

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

[Bùi Mạnh Hùng 0]

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.

[ndtnv 481]

Khai báo là:

Dim dimaligned1 As AcadDimAligned

ObjectName là "AcDbRotatedDimension"

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

 

[Bùi Mạnh Hùng 0]

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.

[alisp 73]

http://help.autodesk.com/view/ACD/2015/JPN/?guid=GUID-A63F1BA4-E105-42C7-951D-043672E61891

có cái gì sai sai trong câu 

Dim object1 As Variant

 

[phantuhuong 226]

Code VBA trong AutoCAD rất gần gũi với VBA trong Office, VB6, VB.NET nhưng lại khác xa AutoCAD.NET. VBA, VB6 hạn chế Unicode thôi, chứ làm việc với VB6 với ứng dụng AutoCAD còn dễ chịu, tường minh bằng vạn so với AutoCAD.NET.

 

[kientl1978 0]

Xin ae cao thủ chỉ giúp, tôi mới học qua về vba cad và excel, tôi đang tập viết 1 cad sub để lấy thông tin của text chuyển qua excel (KL mặt cắt), tôi mới chỉ làm được với từng m/c riêng lẻ theo các hướng dẫn trên web, xắp xếp thông tin lấy dc theo 1 cột chỉ định trong excel. Để nhập thông tin này vào bảng tính KL mặt cắt, tôi phải viết thêm 1 sub nhập liệu trên file KL đó. Tôi muốn hỏi ae liệu mình có thể gọi sub nhập liệu của excel ngay trong sub của cad không (đỡ tốn công quay đi, quay lại giữa cad và excel), nếu dc thì mình phải viết cú pháp gọi sub excel trong sub của cad thế nào (ví dụ gọi sub Lenh_Luu của excel trong sub gettext của cad trong file đính kèm). Cảm ơn ae trước nhiều nhé. 

getTxt1.rar

[Namvanvo 44]

Vào lúc 3/10/2021 tại 10:50, kientl1978 đã nói:

Xin ae cao thủ chỉ giúp, tôi mới học qua về vba cad và excel, tôi đang tập viết 1 cad sub để lấy thông tin của text chuyển qua excel (KL mặt cắt), tôi mới chỉ làm được với từng m/c riêng lẻ theo các hướng dẫn trên web, xắp xếp thông tin lấy dc theo 1 cột chỉ định trong excel. Để nhập thông tin này vào bảng tính KL mặt cắt, tôi phải viết thêm 1 sub nhập liệu trên file KL đó. Tôi muốn hỏi ae liệu mình có thể gọi sub nhập liệu của excel ngay trong sub của cad không (đỡ tốn công quay đi, quay lại giữa cad và excel), nếu dc thì mình phải viết cú pháp gọi sub excel trong sub của cad thế nào (ví dụ gọi sub Lenh_Luu của excel trong sub gettext của cad trong file đính kèm). Cảm ơn ae trước nhiều nhé. 

getTxt1.rar

Được ạ, bác có thể tạo sub để thực hiện công việc trong excel ngay trong sub của cad, hoặc ngược lại, bác có thể tạo sub để thực hiện các công việc trên excel cho excel và cho cad.

[Thanh3da 0]

Xin chào các bạn, tôi có viết 1 số đoạn code VBA về đối tượng layer trong Cad. Mong các bạn dùng thử và cho nhận xét. Thanks!

 

[Nguyencong chuan 3]

Em có một file VBA em load xong nó ra ntn mong mọi người giúp đỡ em ạ

 

Link tải file đây ạ https://drive.google.com/file/d/1SAJMWp4meCLxkZW0T1B8kAyWZoF-wtnR/view?usp=sharing

[chung_td 1]

Tuyệt vời!

[haivip1189 0]

Vào lúc 9/9/2022 tại 11:11, Nguyễn Hà Huy đã nói:

mn ơi, ai có link cài vba cho autocad ko ạ?

 

Chịu khó search GG đi bạn: https://knowledge.autodesk.com/support/autocad/downloads/caas/downloads/content/download-the-microsoft-vba-module-for-autocad.html

Chọn pb phù hợp