nemoxinh 0 Báo cáo bài đăng Đã đăng Tháng 2 16, 2012 Thank. 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
mechatronics 0 Báo cáo bài đăng Đã đăng Tháng 4 12, 2012 Để so sánh giữa 2 môi trường, tôi thực hiện bài toán đơn giản nhất cho dễ hiểu. Hai thủ tục viết trong Excel và AutoCad như sau: Trong Excel Public AcadApp As AcadApplication Sub Hinh_Tru_Excel() Dim i As Integer Dim AcadMo As AcadModelSpace Dim AcadUt As AcadUtility Dim DiemDauP As Variant 'Diem dau tien de ve Dim DiemBaoP(0 To 11) As Double 'Diem bao phan to mat cat 'Khai bao ghi ky hieu Ten lop Dim GhiTenlopP(0 To 2) As Double Dim Tenlop As String Dim TenlopT As AcadText 'Khai bao ghi do sau lop Dim GhiDosauP(0 To 2) As Double Dim DosauT As AcadText 'Khai bao To mat cat Dim MatcatH As AcadHatch Dim VongbaoPL(0) As AcadPolyline 'Khai bao noi dung Hinh tru Dim HinhTruP(0 To 2) As Double Dim HinhTruT As AcadText 'Khai bao ty le dung Hinh tru Dim TLdung As Single Dim TLdungP(0 To 2) As Double Dim TLdungT As AcadText 'Khai bao chieu rong cua phan To ky hieu dia tang va Pi Const Chieurong = 10: Const Pi = 3.14159 '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Call KhoidongAutoCad 'Thiet lap font ".VnArial" cho kieu "Standard" Set TxtStyleObj = AcadApp.ActiveDocument.TextStyles.Item("Standard") TxtStyleObj.SetFont ".VnArial", False, False, 0, 34 'Xac dinh Ty le dung TLdung = Val(ThisWorkbook.Sheets("Khai bao").Range("J3")) '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Set AcadMo = AcadApp.ActiveDocument.ModelSpace Set AcadUt = AcadApp.ActiveDocument.Utility DiemDauP = AcadUt.GetPoint(, "Vao vi tri dau tien:") 'Ghi noi dung ten Hinh tru va Ty le dung HinhTruP(0) = DiemDauP(0) + 8 HinhTruP(1) = DiemDauP(1) + 4 Set HinhTruT = AcadMo.AddText("HINH TRU HO KHOAN", HinhTruP, 1.5) TLdungP(0) = HinhTruP(0) + 5 TLdungP(1) = HinhTruP(1) - 2.5 Set TLdungT = AcadMo.AddText("Tû lÖ ®øng: 1/" & TLdung, TLdungP, 1) TLdungT.ObliqueAngle = 0.15 DiemBaoP(0) = DiemDauP(0) DiemBaoP(1) = DiemDauP(1) 'Tao vong lap duyet qua tung lop With ThisWorkbook.Worksheets("Khai bao").Range("B2") i = 1 Do 'Xac dinh do chenh sau giua cac lop dat Chenhsau = (.Offset(i - 1, 1) - .Offset(i, 1)) * 1000 / TLdung 'Xac dinh cac diem bao va ve duong Polyline DiemBaoP(3) = DiemBaoP(0) + Chieurong: DiemBaoP(4) = DiemBaoP(1) DiemBaoP(6) = DiemBaoP(3): DiemBaoP(7) = DiemBaoP(4) + Chenhsau DiemBaoP(9) = DiemBaoP(6) - Chieurong: DiemBaoP(10) = DiemBaoP(7) Set VongbaoPL(0) = AcadMo.AddPolyline(DiemBaoP) VongbaoPL(0).Closed = True 'Kep kin duong Polyline VongbaoPL(0).Color = acRed 'Ghi ten cac lop dat GhiTenlopP(0) = DiemBaoP(3) + 2 GhiTenlopP(1) = DiemBaoP(4) + Chenhsau / 2 Tenlop = "Líp " & .Offset(i, 0) & ": " & .Offset(i, 2) Set TenlopT = AcadMo.AddText(Tenlop, GhiTenlopP, 0.8) 'Ghi do sau lop GhiDosauP(0) = DiemBaoP(6) + 0.5 GhiDosauP(1) = DiemBaoP(7) Set DosauT = AcadMo.AddText(FormatNumber(.Offset(i, 1), 1), GhiDosauP, 1) DosauT.Color = acRed 'To ky hieu mat cat dia tang Set MatcatH = AcadMo.AddHatch(1, .Offset(i, 4), True) MatcatH.PatternScale = .Offset(i, 5) MatcatH.PatternAngle = .Offset(i, 6) * Pi / 180 MatcatH.AppendOuterLoop (VongbaoPL) MatcatH.Evaluate: MatcatH.Update 'Gan diem de sang lop moi DiemBaoP(0) = DiemBaoP(9) DiemBaoP(1) = DiemBaoP(10) i = i + 1 Loop Until IsEmpty(.Offset(i, 0)) End With AcadApp.ZoomAll 'Xoa bo bien doi tuong Set AcadApp = Nothing Set AcadMo = Nothing Set AcadUt = Nothing End Sub Trong AutoCad Public ExcelApp As Excel.Application Public Const Tenfile = "D:\Khoahoc2008\Hinhtru.xls" Sub VeHinhTru_AutoCad() Dim i As Integer Dim AcadMo As AcadModelSpace Dim AcadUt As AcadUtility Dim DiemDauP As Variant 'Diem dau tien de ve Dim DiemBaoP(0 To 11) As Double 'Diem bao phan to mat cat 'Khai bao ghi ky hieu Ten lop Dim GhiTenlopP(0 To 2) As Double Dim Tenlop As String Dim TenlopT As AcadText 'Khai bao ghi do sau lop Dim GhiDosauP(0 To 2) As Double Dim DosauT As AcadText 'Khai bao To mat cat Dim MatcatH As AcadHatch Dim VongbaoPL(0) As AcadPolyline 'Khai bao noi dung Hinh tru Dim HinhTruP(0 To 2) As Double Dim HinhTruT As AcadText 'Khai bao ty le dung Hinh tru Dim TLdung As Single Dim TLdungP(0 To 2) As Double Dim TLdungT As AcadText 'Khai bao chieu rong cua phan To ky hieu dia tang va Pi Const Chieurong = 10: Const Pi = 3.14159 '''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'Khoi dong Excel Call KhoidongExcel TLdung = Val(ExcelApp.Sheets("Khai bao").Range("J3")) 'Thiet lap font ".VnArial" cho kieu "Standard" Set TxtStyleObj = ActiveDocument.TextStyles.Item("Standard") TxtStyleObj.SetFont ".VnArial", False, False, 0, 34 '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Set AcadMo = ActiveDocument.ModelSpace Set AcadUt = ActiveDocument.Utility DiemDauP = AcadUt.GetPoint(, "Vao vi tri dau tien:") 'Ghi noi dung ten Hinh tru va Ty le dung HinhTruP(0) = DiemDauP(0) + 8 HinhTruP(1) = DiemDauP(1) + 4 Set HinhTruT = AcadMo.AddText("HINH TRU HO KHOAN", HinhTruP, 1.5) TLdungP(0) = HinhTruP(0) + 5 TLdungP(1) = HinhTruP(1) - 2.5 Set TLdungT = AcadMo.AddText("Tû lÖ ®øng: 1/" & TLdung, TLdungP, 1) TLdungT.ObliqueAngle = 0.15 DiemBaoP(0) = DiemDauP(0) DiemBaoP(1) = DiemDauP(1) With ExcelApp.Worksheets("Khai bao").Range("B2") 'Tao vong lap qua tung diem i = 1 Do 'Xac dinh do chenh sau giua cac lop dat Chenhsau = (.Offset(i - 1, 1) - .Offset(i, 1)) * 1000 / TLdung 'Xac dinh cac diem bao va ve duong Polyline DiemBaoP(3) = DiemBaoP(0) + Chieurong: DiemBaoP(4) = DiemBaoP(1) DiemBaoP(6) = DiemBaoP(3): DiemBaoP(7) = DiemBaoP(4) + Chenhsau DiemBaoP(9) = DiemBaoP(6) - Chieurong: DiemBaoP(10) = DiemBaoP(7) Set VongbaoPL(0) = AcadMo.AddPolyline(DiemBaoP) VongbaoPL(0).Closed = True 'Kep kin duong Polyline VongbaoPL(0).color = acRed 'Ghi ten cac lop dat GhiTenlopP(0) = DiemBaoP(3) + 2 GhiTenlopP(1) = DiemBaoP(4) + Chenhsau / 2 Tenlop = "Líp " & .Offset(i, 0) & ": " & .Offset(i, 2) Set TenlopT = AcadMo.AddText(Tenlop, GhiTenlopP, 0.8) 'Ghi do sau lop GhiDosauP(0) = DiemBaoP(6) + 0.5 GhiDosauP(1) = DiemBaoP(7) Set DosauT = AcadMo.AddText(FormatNumber(.Offset(i, 1), 1), GhiDosauP, 1) DosauT.color = acRed 'To ky hieu mat cat dia tang Set MatcatH = AcadMo.AddHatch(1, .Offset(i, 4), True) MatcatH.PatternScale = .Offset(i, 5) MatcatH.PatternAngle = .Offset(i, 6) * Pi / 180 MatcatH.AppendOuterLoop (VongbaoPL) MatcatH.Evaluate: MatcatH.Update 'Gan diem de sang lop moi DiemBaoP(0) = DiemBaoP(9) DiemBaoP(1) = DiemBaoP(10) i = i + 1 Loop Until IsEmpty(.Offset(i, 0)) End With ZoomAll 'Xoa bo bien doi tuong Set ExcelApp = Nothing Set AcadMo = Nothing Set AcadUt = Nothing End Sub Các bạn sẽ thấy hai thủ tục trên giống nhau như 2 chị em sinh đôi! Chính vì vậy bạn sẽ không bị bỡ ngỡ khi chuyển đổi môi trường lập trình VBA Hình 12: Kết quả vẽ hình trụ hố khoan và một số đối tượng vẽ chính Một số đối tượng chính trong thủ tục trên được mô tả trong kết quả vẽ hình trụ hố khoan tại hình 12. Trong đó, những đối tượng trong AutoCad quy ước có đuôi chữ hoa P là point, PL là polyline, T là text, L là line,... 3. Kết luận - Chức năng Automation giúp chúng ta xây dựng các chương trình có khả năng tự động hoá trao đổi dữ liệu giữa các môi trường khác nhau. Sự kết hợp giữa Excel, AutoCad cùng với ngôn ngữ lập trình VBA tích hợp bên trong có thể giải quyết được nhiều bài toán phức tạp khác nhau trong lĩnh vực kỹ thuật. - Giống như VB6, VBA là ngôn ngữ lập trình tiện dụng phát triển trong nhiều ứng dụng, có khả năng ứng dụng mạnh mẽ trong nhiều ngành nghề, cần được quan tâm đúng mức trong việc dạy và học tin học ứng dụng không chuyên trong các trường Đại học. sao hình ảnh lỗi hết vậy bạn. t chẳng xem dc gì cả. hix 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
p.bavinh 1 Báo cáo bài đăng Đã đăng Tháng 5 25, 2013 Tôi có một số code về vba có thể liên hệ giữa autocad và excel. Nếu anh em nào muốn có thể liên lạc với tôi tôi sẽ cho :). yahoo: phambavinh_ht email: bavinh.bavinh@gmail.com 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
nguyendan81985 3 Báo cáo bài đăng Đã đăng Tháng 11 13, 2013 cho mình hỏi. làm thế nào để lấy dữ liệu từ Excel để xử lý trong CAD mình ví dụ thế này: trong VBA CAD có các textbox là L1, L2, L3 trong excel có các cột L1, L2, L3 ở các vị trí A1, B1, C1 tương ứng. vậy làm thế nào để CAD là để gán giá trị từ excel cho CAD. chương trình trong CAD có thể đơn giản làm 1 cái msgbox hiển thị giá trị trong cột L1,L2, L3 .... bạn nào biết chỉ giúp nhé. thanks 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
dinhvantrang 151 Báo cáo bài đăng Đã đăng Tháng 11 14, 2013 cho mình hỏi. làm thế nào để lấy dữ liệu từ Excel để xử lý trong CAD mình ví dụ thế này: trong VBA CAD có các textbox là L1, L2, L3 trong excel có các cột L1, L2, L3 ở các vị trí A1, B1, C1 tương ứng. vậy làm thế nào để CAD là để gán giá trị từ excel cho CAD. chương trình trong CAD có thể đơn giản làm 1 cái msgbox hiển thị giá trị trong cột L1,L2, L3 .... bạn nào biết chỉ giúp nhé. thanks Bạn phải kết nối giữa AutoCad và Excel lại với nhau thì mới lấy dữ liệu qua lại với nhau dc. 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
nguyendan81985 3 Báo cáo bài đăng Đã đăng Tháng 11 14, 2013 Bạn phải kết nối giữa AutoCad và Excel lại với nhau thì mới lấy dữ liệu qua lại với nhau dc. biết là vậy. nhưng phải làm thế nào ấy. bạn biết thì giúp mình 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
hoanguct 0 Báo cáo bài đăng Đã đăng Tháng 12 26, 2013 Với anh em công trình thì món này ngon củng được roài 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
tuminhphuong 0 Báo cáo bài đăng Đã đăng Tháng 4 14, 2016 Mình cần học lớp lập trình ứng dụng VBA để lien kết CAD và exell, bạn nào biết ở đâu mở lớp xin chỉ giúp mì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
dinhvantrang 151 Báo cáo bài đăng Đã đăng Tháng 4 14, 2016 Mình cần học lớp lập trình ứng dụng VBA để lien kết CAD và exell, bạn nào biết ở đâu mở lớp xin chỉ giúp mình. Nếu cần thì mình dạy online cho bạn nhé. Add skype mình: dinhvantrang73 hoặc inbox mail: dinhvantrang73@gmail.com 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
phantuhuong 227 Báo cáo bài đăng Đã đăng Tháng 5 6, 2017 Rất vui là nội dung kết nối này đã được nhiều bạn áp dụng trong việc kết nối giữa 2 môi trường Excel và AutoCad. Nhờ khả năng này mà công việc được tự động hóa với kết quả chính xác cao. 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
pdhuyxn2 8 Báo cáo bài đăng Đã đăng Tháng 3 12, 2019 Nhờ Các Cao thủ sửa lỗi giúp em với: Trước em sử dụng add-in trên cad2008 và excel 2003 trên win 7 32bít. Bây giờ sử dụng cad2017 và excel 2016 trên win 64 bị lỗi không sử dụng được. Kính nhờ Các Bác Giúp em với. Em cám ơn ạ! didg.rar 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
pdhuyxn2 8 Báo cáo bài đăng Đã đăng Tháng 3 14, 2019 Vào lúc 12/3/2019 tại 09:55, pdhuyxn2 đã nói: Nhờ Các Cao thủ sửa lỗi giúp em với: Trước em sử dụng add-in trên cad2008 và excel 2003 trên win 7 32bít. Bây giờ sử dụng cad2017 và excel 2016 trên win 64 bị lỗi không sử dụng được. Kính nhờ Các Bác Giúp em với. Em cám ơn ạ! didg.rar Nhờ Các Cao thủ sửa lỗi giúp em với ạ! 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
pdhuyxn2 8 Báo cáo bài đăng Đã đăng Tháng 4 13, 2019 Vào lúc 12/3/2019 tại 09:55, pdhuyxn2 đã nói: Nhờ Các Cao thủ sửa lỗi giúp em với: Trước em sử dụng add-in trên cad2008 và excel 2003 trên win 7 32bít. Bây giờ sử dụng cad2017 và excel 2016 trên win 64 bị lỗi không sử dụng được. Kính nhờ Các Bác Giúp em với. Em cám ơn ạ! didg.rar Nhờ các bác chỉnh giú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
dinhvantrang 151 Báo cáo bài đăng Đã đăng Tháng 4 14, 2019 Bạn có thể post lỗi lên đây được không? Với lại fil Add-In này có pass, bạn có thể inbox mình pass để mình xem qua cho 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
pdhuyxn2 8 Báo cáo bài đăng Đã đăng Tháng 5 13, 2019 Vào lúc 14/4/2019 tại 21:11, dinhvantrang đã nói: Em bỏ Pas rồi ạ mong Bác Giúp đỡ didg.rar 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
pdhuyxn2 8 Báo cáo bài đăng Đã đăng Tháng 5 14, 2019 Vào lúc 14/4/2019 tại 21:11, dinhvantrang đã nói: Bạn có thể post lỗi lên đây được không? Với lại fil Add-In này có pass, bạn có thể inbox mình pass để mình xem qua cho nhé Nhờ Các Bác trên diễn đàn chỉnh sửa giúp sử dụng cad2017 và excel 2016 trên win 64 với ạ. 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
pdhuyxn2 8 Báo cáo bài đăng Đã đăng Tháng 5 16, 2019 Vào lúc 14/4/2019 tại 21:11, dinhvantrang đã nói: Bạn có thể post lỗi lên đây được không? Với lại fil Add-In này có pass, bạn có thể inbox mình pass để mình xem qua cho nhé Cài cad2017 và excel 2003 vẫn sử dụng bình thường sang excel 2016 thì bị lỗi ? 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
pdhuyxn2 8 Báo cáo bài đăng Đã đăng Tháng 5 22, 2019 kHÔNG BIẾT LỖI DO ĐÂU MÀ KHÔNG CHAY ĐƯỢC EXCEL2016 Sub text2xls() 'Dim sset As AcadSelectionSet Dim texts() Dim lines() Dim gpCode(0) As Integer 'filter code Dim dataValue(0) As Variant On Error Resume Next Set acadapp = GetObject(, "AutoCAD.Application") 'autocadÁöÁ¤ If Err Then MsgBox "AutoCAD¸¦ ½ÇÇàÇØ ÁÖ¼¼¿ä" End End If Set acaddoc = acadapp.ActiveDocument 'ÇöÀç document ÁöÁ¤ Set acadutil = acaddoc.Utility 'utilityÁöÁ¤ acadapp.Visible = True AppActivate acadapp.Caption 'ijµå¸¦ È°¼ºÈ gpCode(0) = 0 'filter ÄÚµå : entity type dataValue(0) = "Text" ' filter value : "Text" If acaddoc.SelectionSets.Count <> 0 Then acaddoc.SelectionSets("sset1").Delete Set sset = acaddoc.SelectionSets.Add("sset1") On Error Resume Next sset.SelectOnScreen gpCode, dataValue If Err Or sset.Count = 0 Then AppActivate ActiveWorkbook.Application.Caption MsgBox "Text¸¦ ¼±ÅÃÇØÁÖ¼¼¿ä" End End If ReDim texts(sset.Count - 1) For I = 0 To sset.Count - 1 Set texts(I) = sset.Item(I) Next I sort_entityxy texts, sp, nrows 'text¸¦ xy¹æÇâÀ¸·Î Á¤·ÄÇϱâ msg = vbCrLf & CStr(UBound(texts) + 1) & " texts found, " & CStr(nrows) & " Lines found" & vbCrLf & "Select virtical lines" If Left(acadapp.Version, 2) = "14" Then AppActivate ActiveWorkbook.Application.Caption MsgBox msg Else acadutil.Prompt msg End If If UBound(sp) > 0 Then ' ¿©·¯ÁÙÀÏ ¶§ If sp(0) > 1 Then '¿©·¯Ä÷³ÀÏ ¶§. ÇÑÄ÷³ÀÏ ¶§´Â ¾Æ¹«°Íµµ ÇÏÁö ¾ÊÀ½ gpCode(0) = 0 'filter ÄÚµå : entity type dataValue(0) = "Line" ' filter value : "Text" If acaddoc.SelectionSets.Count <> 0 Then acaddoc.SelectionSets("sset1").Delete Set sset = acaddoc.SelectionSets.Add("sset1") AppActivate acadapp.Caption On Error Resume Next sset.SelectOnScreen gpCode, dataValue If Err Or sset.Count = 0 Then AppActivate ActiveWorkbook.Application.Caption MsgBox "¼¿À» ±¸ºÐÇϱâ À§ÇÑ ¼öÁ÷¼±À» ¼±ÅÃÇØÁÖ¼¼¿ä" End End If ReDim lines(sset.Count - 1) For I = 0 To sset.Count - 1 Set lines(I) = sset.Item(I) Next I get_sepx_lines lines, sepxa 'lineÀÇ ½ÃÀÛÁ¡À» ÀÌ¿ëÇÏ¿© Ä÷³±¸ºÐ¼± ±¸Çϱâ End If Else 'ÇÑÁÙÀ϶§ get_sepx_txts texts, sp, sepxa 'ùÁÙ text¸¦ ÀÌ¿ëÇÏ¿© Ä÷³±¸ºÐ¼± ±¸Çϱâ End If put2sheet texts, sp, sepxa 'ÁÖ¾îÁø text¸¦ ÁÙ(sp), Ä(sepxa) Á¤º¸¿¡ ¬Ãç¼ sheet¿¡ ³Ö±â 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