Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
huunhantvxdts

Ứng dụng vba kết hợp Excell và Cad vẽ trắc dọc cống chỉ 1 cú pick

Bởi huunhantvxdts , trong Lập trình khác

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

huunhantvxdts    195

huunhantvxdts
Đã đăng

Sau 1 thời gian mày mò mình đã thêm bớt một số cái (hay còn gọi là nâng cấp hoàn thiện hơn) mong mọi người có ý kiến thêm
Rất cám ơn mọi người quan tâm
Đây ứng dụng mình tự mày mò nên chủ yếu là mình cần cái gì mình bỏ sung thêm cái đó. về giải thuật theo đánh giá của mình là thủ công. nhưng khi chạy ứng dụng thì cũng tạm ổn. đỡ phải vẽ cad.
để chạy ứng dụng
1. tải file đính kèm (Excell)
2. mở autocad 2008 (mình mởi thử ở phiên bản này, các phiên bản khác mình chưa thử)
3. mở file excell ( excelll 2003) vừa tải. nhập vào những giá trị thiết kế cơ bản (Cao độ TK, Cao độ TN, Lý trình.....)
4. Bây giơ chỉ pick chuột vào " VẼ CỐNG HOÀN THIỆN"
Đây là link down mới
http://www.4shared.com/office/stn_vCOR/Ve_cong_moi.html

đây là code

Private Sub TaoLayers()
Dim duongtk As AcadLayer
Dim duongtn As AcadLayer
Dim duongdg As AcadLayer
Dim duonghg As AcadLayer
Dim duongcg As AcadLayer
Dim duongkg As AcadLayer
Dim loptext As AcadLayer
Dim layertypeName As String
layertypeName = "center"
Set duongtk = AcadApplication.ActiveDocument.Layers.Add("duongthietke") 'Tao layer "duong thiet ke"
duongtk.Color = acRed 'chon màu nét cua Layer "duongthietke"
On Error Resume Next
AcadApplication.ActiveDocument.Linetypes.Load layertypeName, "acad.lin" 'Load kieu nét ACAD_ISO03W1000 de san sàng các layers có the su dung
Set duongtn = AcadApplication.ActiveDocument.Layers.Add("duongtunhien") 'tao layer "duongtunhien"
duongtn.Color = acGreen
duongtn.Linetype = "continuous" 'chon kieu net cho layer "duong tu nhien"
Set duongdg = AcadApplication.ActiveDocument.Layers.Add("duongdong") 'tao layer "duong dong"
duongdg.Color = 8
duongdg.Linetype = "continuous" 'chon kieu net cho layer "duong dong"
Set duonghg = AcadApplication.ActiveDocument.Layers.Add("hoga") 'tao layer "duong ho ga"
duonghg.Color = acBlue
duonghg.Linetype = "continuous" 'chon kieu net cho layer "duong ho ga"
Set duongcg = AcadApplication.ActiveDocument.Layers.Add("Cong") 'tao layer "duong cong"
duongcg.Color = acRed
duongcg.Linetype = "continuous" 'chon kieu net cho layer "duong cong"
Set duongkg = AcadApplication.ActiveDocument.Layers.Add("duongkhung") 'tao layer "duong khung"
duongkg.Color = acGreen
duongkg.Linetype = "continuous" 'chon kieu net cho layer "duong khung"
Set loptext = AcadApplication.ActiveDocument.Layers.Add("text") 'tao layer "text"
loptext.Color = acRed
End Sub
Sub TaoTextStyle()
Dim TextStyleObj As AcadTextStyle
Set TextStyleObj = ActiveDocument.TextStyles.Add("chuhoa")
TextStyleObj.SetFont ".VnArial NarrowH", True, False, 0, 34
Set TextStyleObj = ActiveDocument.TextStyles.Add("chuso")
TextStyleObj.SetFont ".VnArial Narrow", True, False, 0, 34
End Sub
Sub VeLine1(cott1 As Integer, cott2 As Integer)
Dim cong As AcadLine
Dim offset As Variant
Dim x1(0 To 2) As Double
Dim x2(0 To 2) As Double
Dim i As Double
Dim j As Double
i = 13
j = i + 1
Do While Not Sheets("Vecong").Cells(j, cott1).Value = ""
x1(0) = Sheets("Vecong").Cells(i, cott1)
x1(1) = Sheets("Vecong").Cells(i, cott2)
x1(2) = 0
x2(0) = Sheets("Vecong").Cells(j, cott1)
x2(1) = Sheets("Vecong").Cells(j + 1, cott2)
x2(2) = 0

Set cong = AcadApplication.ActiveDocument.ModelSpace.AddLine(x1, x2)
offset = cong.offset(Sheets("vecong").Cells(j, 11))
i = i + 2
j = j + 2
Loop
Set cong = Nothing
'ZoomAll
End Sub
Sub VeLine(cot1 As Integer, cot2 As Integer)
Dim blk As AcadLine
Dim x1(0 To 2) As Double
Dim x2(0 To 2) As Double
Dim i As Double
Dim j As Double
i = 13
j = i + 2
Do While Not Sheets("Vecong").Cells(j, cot1).Value = ""
x1(0) = Sheets("Vecong").Cells(i, cot1)
x1(1) = Sheets("Vecong").Cells(i, cot2)
x1(2) = 0
x2(0) = Sheets("Vecong").Cells(j, cot1)
x2(1) = Sheets("Vecong").Cells(j, cot2)
x2(2) = 0
Set blk = AcadApplication.ActiveDocument.ModelSpace.AddLine(x1, x2)
i = i + 2
j = j + 2
Loop
Set blk = Nothing
'ZoomAll
End Sub
Sub duongkhung()
Dim linebang As AcadLine
Dim x1(0 To 2) As Double
Dim x2(0 To 2) As Double
Dim offset As Variant
Dim i As Integer
x1(0) = Sheets("Vecong").Cells(13, 31)
x1(1) = Sheets("Vecong").Cells(13, 32)
x1(2) = 0
x2(0) = Sheets("Vecong").Cells(15, 31)
x2(1) = Sheets("Vecong").Cells(15, 32)
x2(2) = 0
Set linebang = AcadApplication.ActiveDocument.ModelSpace.AddLine(x1, x2)
i = 5
Do While i <= 14
offset = linebang.offset(Sheets("Bangbieu").Cells(i, 3))
offset(0).Update
i = i + 1
Loop
Set linebang = Nothing
End Sub
Sub moautocad()
Dim acadapp As AcadApplication
On Error Resume Next
Set acadapp = GetObject(, "autocad.application")
If Err Then
Err.Clear
Set acadapp = GetObject("autocad.application")
If Err Then
MsgBox Err.Description
Exit Sub
End If
End If
acadapp.Visible = True
If acadapp.WindowState = acMax Then acadapp.WindowState = acMin
acadapp.WindowState = acMax
'MsgBox " Dang chay " + acadapp.Name + " phien ban " + acadapp.Version
End Sub
Sub veply(cot1 As Integer, cot2 As Integer, cot3 As Integer)
Dim ply As AcadPolyline
Dim x(0 To 11) As Double
Dim i As Integer
Dim j As Integer
i = 12
j = i + 1
Do While Not Sheets("Vecong").Cells(j, cot1).Value = ""
x(0) = Sheets("Vecong").Cells(i, cot1)
x(1) = Sheets("Vecong").Cells(j, cot2)
x(2) = 0
x(3) = Sheets("Vecong").Cells(i, cot1)
x(4) = Sheets("Vecong").Cells(j, cot3)
x(5) = 0
x(6) = Sheets("Vecong").Cells(j, cot1)
x(7) = Sheets("Vecong").Cells(j, cot3)
x(8) = 0
x(9) = Sheets("Vecong").Cells(j, cot1)
x(10) = Sheets("Vecong").Cells(j, cot2)
x(11) = 0
Set ply = AcadApplication.ActiveDocument.ModelSpace.AddPolyline(x)
i = i + 2
j = j + 2
Loop
Set ply = Nothing
'ZoomAll
End Sub
Sub duongdong(cot1 As Integer, cot2 As Integer, cot3 As Integer)
Dim duong As AcadLine
Dim x1(0 To 2) As Double
Dim x2(0 To 2) As Double
Dim i As Double
i = 13
Do While Not Sheets("Vecong").Cells(i, cot1).Value = ""
x1(0) = Sheets("Vecong").Cells(i, cot1)
x1(1) = Sheets("Vecong").Cells(i, cot2)
x1(2) = 0
x2(0) = Sheets("Vecong").Cells(i, cot1)
x2(1) = Sheets("Vecong").Cells(i, cot3)
x2(2) = 0
Set duong = AcadApplication.ActiveDocument.ModelSpace.AddLine(x1, x2)
i = i + 2
Loop
Set duong = Nothing
'ZoomAll
End Sub
Sub diengiatritext(cot1 As Integer, cot2 As Integer, hang As Integer)
Dim giatritext As AcadText
Dim x(0 To 2) As Double
Dim hchu As Double
Dim gocnghieng As Double
Dim noidung As String
Dim i As Integer
i = 13
Do While Not Sheets("Vecong").Cells(i, cot1).Value = ""
x(0) = Sheets("vecong").Cells(i, cot1)
x(1) = Sheets("Bangbieu").Cells(hang, 13)
x(2) = 0
noidung = Sheets("vecong").Cells(i + 1, cot2).Value
hchu = Sheets("vecong").Cells(2, 8).Value
Set giatritext = AcadApplication.ActiveDocument.ModelSpace.AddText(noidung, x, hchu)
giatritext.Alignment = acAlignmentMiddleCenter
giatritext.TextAlignmentPoint = x
gocnghieng = 0 / 180 * 3.14159
giatritext.Rotate x, gocnghieng
giatritext.Update
i = i + 2
Loop
Set giatritext = Nothing
'ZoomAll
End Sub
Sub diencaodo(cot1 As Integer, cot2 As Integer, hang As Integer)
Dim caodo As AcadText
Dim x(0 To 2) As Double
Dim hchu As Double
Dim gocnghieng As Double
Dim noidung As String
Dim i As Integer
i = 13
Do While Not Sheets("Vecong").Cells(i, cot1).Value = ""
x(0) = Sheets("vecong").Cells(i, cot1)
x(1) = Sheets("Bangbieu").Cells(hang, 13)
x(2) = 0
noidung = Sheets("vecong").Cells(i, cot2).Value
hchu = Sheets("vecong").Cells(2, 8).Value
Set caodo = AcadApplication.ActiveDocument.ModelSpace.AddText(noidung, x, hchu)
caodo.Alignment = acAlignmentMiddleCenter
caodo.TextAlignmentPoint = x
gocnghieng = 90 / 180 * 3.14159
caodo.Rotate x, gocnghieng
caodo.Update
i = i + 2
Loop
Set caodo = Nothing
'ZoomAll
End Sub
Sub dienchenhcao(cot1 As Integer, cot2 As Integer, cot3 As Integer)
Dim caodo As AcadText
Dim x(0 To 2) As Double
Dim hchu As Double
Dim gocnghieng As Double
Dim noidung As String
Dim i As Integer
i = 13
Do While Not Sheets("Vecong").Cells(i, cot1).Value = ""
x(0) = Sheets("vecong").Cells(i, cot1)
x(1) = Sheets("vecong").Cells(i, cot3)
x(2) = 0
noidung = Sheets("vecong").Cells(i, cot2).Value
hchu = Sheets("vecong").Cells(2, 8).Value
Set caodo = AcadApplication.ActiveDocument.ModelSpace.AddText(noidung, x, hchu)
caodo.Alignment = acAlignmentLeft
gocnghieng = 90 / 180 * 3.14159
caodo.Rotate x, gocnghieng
caodo.Update
i = i + 2
Loop
Set caodo = Nothing
'ZoomAll
End Sub
Sub diendaubang()
Dim caodo As AcadText
Dim x(0 To 2) As Double
Dim hchu As Double
Dim gocnghieng As Double
Dim noidung As String
Dim j As Integer
AcadApplication.ActiveDocument.ActiveTextStyle = AcadApplication.ActiveDocument.TextStyles("chuhoa")
j = 5
Do While Not IsEmpty(Sheets("Bangbieu").Cells(j, 2))
x(0) = Sheets("Bangbieu").Cells(1, 8)
x(1) = Sheets("Bangbieu").Cells(j, 13)
x(2) = 0
noidung = Sheets("Bangbieu").Cells(j, 2).Value
hchu = Sheets("vecong").Cells(2, 8).Value
Set caodo = AcadApplication.ActiveDocument.ModelSpace.AddText(noidung, x, hchu)
caodo.Alignment = acAlignmentMiddleCenter
caodo.TextAlignmentPoint = x
caodo.Update
j = j + 1
Loop
Set caodo = Nothing
'ZoomAll
End Sub
Sub dienhoga(cot1 As Integer, cot2 As Integer, hang As Integer)
Dim caodo As AcadText
Dim x(0 To 2) As Double
Dim hchu As Double
Dim gocnghieng As Double
Dim noidung As String
Dim i As Integer
i = 13
Do While Not Sheets("Vecong").Cells(i, cot1).Value = ""
x(0) = Sheets("vecong").Cells(i, cot1)
x(1) = Sheets("Bangbieu").Cells(hang, 13)
x(2) = 0
noidung = Sheets("vecong").Cells(i, cot2).Value
hchu = Sheets("vecong").Cells(2, 8).Value
Set caodo = AcadApplication.ActiveDocument.ModelSpace.AddText(noidung, x, hchu)
caodo.Alignment = acAlignmentMiddleCenter
caodo.TextAlignmentPoint = x
gocnghieng = 0 / 180 * 3.14159
caodo.Rotate x, gocnghieng
caodo.Update
i = i + 2
Loop
Set caodo = Nothing
'ZoomAll
End Sub
Sub laydiemdat()
Dim xpoint As AcadUtility
Dim ypoint As AcadUtility
Dim point As Variant

'MsgBox ("Diem dat trac doc")
'point = AcadApplication.ActiveDocument.ModelSpace.AddPoint("nhap mot diem")
'AcadApplication.ActiveDocument.Utility.Prompt (vbCrLf & " Diem dat trac doc")
point = AcadApplication.ActiveDocument.Utility.GetPoint(, "diem dat trac doc")
Sheets("Vecong").Cells(2, 5) = point(0)
Sheets("Vecong").Cells(3, 5) = point(1)
'AcadApplication.ActiveDocument.UserCoordinateSystems.Add , point(0), point(1), ""
End Sub
Private Sub CommandButton1_Click()
'day cong
AcadApplication.ActiveDocument.ActiveLayer = AcadApplication.ActiveDocument.Layers("Cong")
Call VeLine1(15, 19)
End Sub
Private Sub CommandButton2_Click()
'dinh cong
AcadApplication.ActiveDocument.ActiveLayer = AcadApplication.ActiveDocument.Layers("Cong")
Call VeLine1(15, 21)
End Sub
Private Sub CommandButton3_Click()
'duong tu nhien
AcadApplication.ActiveDocument.ActiveLayer = AcadApplication.ActiveDocument.Layers("duongtunhien")
Call VeLine(14, 7)
End Sub
Private Sub CommandButton4_Click()
'duong thiet ke
AcadApplication.ActiveDocument.ActiveLayer = AcadApplication.ActiveDocument.Layers("duongthietke")
Call VeLine(14, 5)
End Sub
Private Sub CommandButton5_Click()
'day ho ga
AcadApplication.ActiveDocument.ActiveLayer = AcadApplication.ActiveDocument.Layers("hoga")
Call veply(15, 17, 23)
End Sub
Private Sub CommandButton6_Click()
'Dinh ho ga
AcadApplication.ActiveDocument.ActiveLayer = AcadApplication.ActiveDocument.Layers("hoga")
Call veply(15, 17, 5)
End Sub
Private Sub CommandButton7_Click()
'duong dong
AcadApplication.ActiveDocument.ActiveLayer = AcadApplication.ActiveDocument.Layers("duongdong")
Call duongdong(14, 5, 24)
End Sub
Private Sub CommandButton8_Click()
'Duong bao ho ga
AcadApplication.ActiveDocument.ActiveLayer = AcadApplication.ActiveDocument.Layers("hoga")
Call veply(25, 5, 27)
End Sub
Private Sub CommandButton9_Click()
AcadApplication.ActiveDocument.ActiveLayer = AcadApplication.ActiveDocument.Layers("text")
AcadApplication.ActiveDocument.ActiveTextStyle = AcadApplication.ActiveDocument.TextStyles("chuso")
'khoang cach le
Call diengiatritext(35, 30, 16)
'do doc doc
Call diengiatritext(36, 41, 17)
'duong kinh cong
Call diengiatritext(29, 40, 6)
End Sub
Private Sub CommandButton10_Click()
AcadApplication.ActiveDocument.ActiveLayer = AcadApplication.ActiveDocument.Layers("text")
'Cao do nap dan
Call diencaodo(14, 4, 8)
'Cao do day cong
Call diencaodo(14, 16, 9)
'Cao do day ho ga
Call diencaodo(14, 22, 10)
'do chenh cao TK - D.Cong
Call dienchenhcao(14, 37, 38)
AcadApplication.ActiveDocument.ActiveLayer = AcadApplication.ActiveDocument.Layers("duongtunhien")
'khoang cach cong don
Call diencaodo(14, 28, 7)
'Cao do tu nhien
Call diencaodo(14, 6, 11)
'Ki hieu ho ga
Call dienhoga(14, 2, 12)
'Ly trinh theo tuyen chinh
Call dienhoga(14, 3, 13)
End Sub
Private Sub CommandButton11_Click()
AcadApplication.ActiveDocument.ActiveLayer = AcadApplication.ActiveDocument.Layers("duongkhung")
Call duongkhung
Call duongdong(31, 32, 33)
Call duongdong(14, 24, 34)
Call duongdong(39, 32, 33)
End Sub
Private Sub CommandButton12_Click()
Call moautocad
Call TaoLayers
Call TaoTextStyle
Call laydiemdat
Call CommandButton1_Click
Call CommandButton2_Click
Call CommandButton3_Click
Call CommandButton4_Click
Call CommandButton5_Click
Call CommandButton6_Click
Call CommandButton7_Click
Call CommandButton8_Click
Call CommandButton9_Click
Call CommandButton10_Click
Call CommandButton11_Click
Call diendaubang
End Sub

Cập nhật clip 

https://www.youtube.com/watch?v=cjwuUw3sx5I

Similar topics from web:
VBA
Thảo luận về Autolisp
  • Vote tăng 5

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

ketxu    2995

ketxu
Đã đăng

Ứng dụng tốt,vì mình không có chuyên ngành nên cũng không biết mức độ hoàn thiện. Chỉ có vấn đề là nếu bạn không cung cấp lựa chọn điểm đặt thì tất cả đều vẽ lên 1 chỗ à ^^

Khi muốn thêm tọa độ tiếp theo thì phải copy , insert khá phiền phức, bạn có thể cung cấp giao diện add vào cho thân thiện :)

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

huunhantvxdts    195

huunhantvxdts
Đã đăng

Ứng dụng tốt,vì mình không có chuyên ngành nên cũng không biết mức độ hoàn thiện. Chỉ có vấn đề là nếu bạn không cung cấp lựa chọn điểm đặt thì tất cả đều vẽ lên 1 chỗ à ^^

Khi muốn thêm tọa độ tiếp theo thì phải copy , insert khá phiền phức, bạn có thể cung cấp giao diện add vào cho thân thiện :)

Ở bảng excell mình có tọa độ đầu bảng x,y (tạo độ điểm chèn) rồi

muốn đặt ở đâu thi chỉ việc thay đổi tạo độ

còn giao diện thì mình không biết làm

mình gà lắm như mình nói ở trên đây là ứng dụng mà mình tự viết mà chủ yếu là lượm lặt các câu lệnh rồi chế lại. cái nào mà không chạy được thì lên mạng hỏi thêm. còn việc làm giao diện rồi add vào thì mình không thể làm được (không biết làm thế nào cả)

Cám ơn bạn đã quan tâm nếu được bạn có thể chỉnh sữa lại cho hoàn thiện hơn

Cám ơn bạn 1 lần nữa

  • 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

ketxu    2995

ketxu
Đã đăng

Ở bảng excell mình có tọa độ đầu bảng x,y (tạo độ điểm chèn) rồi

muốn đặt ở đâu thi chỉ việc thay đổi tạo độ

còn giao diện thì mình không biết làm

mình gà lắm như mình nói ở trên đây là ứng dụng mà mình tự viết mà chủ yếu là lượm lặt các câu lệnh rồi chế lại. cái nào mà không chạy được thì lên mạng hỏi thêm. còn việc làm giao diện rồi add vào thì mình không thể làm được (không biết làm thế nào cả)

Cám ơn bạn đã quan tâm nếu được bạn có thể chỉnh sữa lại cho hoàn thiện hơn

Cám ơn bạn 1 lần nữa

Lâu rồi mình k viết VBA nên quên hết rồi, giờ đọc code của bạn hơi ngại ^^. Tuy nhiên việc thay khai báo x bằng vị trí bạn có thể cho nó vào 1 đối số của func / sub, và dùng acadutility để lấy tọa độ người pick gán cho hàm, chắc chắn là không khó đâu

- Add dữ liệu nếu k làm form bạn có thể làm gọn đi, chỉ hiện những thứ - sheet cần thiết cho quá trình nhập liệu thì đỡ rối mắt hơn ^^

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    226

phantuhuong
Đã đăng

Muốn chương trình thích ứng với mọi phiên bản AutoCad, bạn khai báo toàn bộ biến đối tượng trong AutoCad thành Object hết. Trước khi chuyển nhớ test cẩn thận trướ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

Detailing    281

Detailing
Đã đăng

Muốn chương trình thích ứng với mọi phiên bản AutoCad, bạn khai báo toàn bộ biến đối tượng trong AutoCad thành Object hết. Trước khi chuyển nhớ test cẩn thận trước.

Các bạn cẩn thận với phần này vì chương trình có thể gọi bất cứ AutoCAD version nào nhưng các method và function của các đối tượng trong phiên bản AutoCAD có thể thay đổi thuộc tính và tên nên chưa chắc là nó work với tất cả đâu.

Ví dụ như TextStyle Table của R17 và R18 có sự thay đổi.

Thân!

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

huunhantvxdts    195

huunhantvxdts
Đã đăng

Lâu rồi mình k viết VBA nên quên hết rồi, giờ đọc code của bạn hơi ngại ^^. Tuy nhiên việc thay khai báo x bằng vị trí bạn có thể cho nó vào 1 đối số của func / sub, và dùng acadutility để lấy tọa độ người pick gán cho hàm, chắc chắn là không khó đâu

- Add dữ liệu nếu k làm form bạn có thể làm gọn đi, chỉ hiện những thứ - sheet cần thiết cho quá trình nhập liệu thì đỡ rối mắt hơn ^^

ok. mình chỉ cần lấy tọa độ vừa pick cho vào vị trí x y là được phải không???

vậy để mình tìm xem cấu trúc lệnh lấy tọa độ rồi bổ sung thê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

huunhantvxdts    195

huunhantvxdts
Đã đăng

Muốn chương trình thích ứng với mọi phiên bản AutoCad, bạn khai báo toàn bộ biến đối tượng trong AutoCad thành Object hết. Trước khi chuyển nhớ test cẩn thận trước.

đây là ứng dụng chỉ dựa trên những sub và func có sẵn, rồi mình chế lại nên mình không hiểu nhiều lắm về những khai báo cho phù hợp. nên giờ phải đổi lại toàn bộ biến cũng hơi ngạ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

huunhantvxdts    195

huunhantvxdts
Đã đăng

Ứng dụng tốt,vì mình không có chuyên ngành nên cũng không biết mức độ hoàn thiện. Chỉ có vấn đề là nếu bạn không cung cấp lựa chọn điểm đặt thì tất cả đều vẽ lên 1 chỗ à ^^

Khi muốn thêm tọa độ tiếp theo thì phải copy , insert khá phiền phức, bạn có thể cung cấp giao diện add vào cho thân thiện :)

đã chỉnh sữa có điểm chèn rồi nhưng vấn đề là Autocad không hiện lên để mình pick luôn mà phải Alt+Tab để chuyển đến Autocad. Bạn có thể cho mình biết lệnh nào để gọi Autocad hiện lên không???

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

huunhantvxdts    195

huunhantvxdts
Đã đăng

Bạn thử để

objAcadApp.Visible = True

objAcadApp.WindowState = acMax

xem sao

Cám ơn bạn mình đã làm được rồi còn vấn đề nữa nhờ bạn chỉ thêm, mình muốn khi xuất ra cad các cao độ và khoảng cách có 2 chữ số lẻ (2 chữ số sau dấ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

huunhantvxdts    195

huunhantvxdts
Đã đăng

Sao không ai có ý kiến gì nhỉ????

mình còn 1 thắc mắc nữa là làm sao để khi xuất sang cad các chữ số đều lấy 2 chữ số lẻ

mong các cao thủ chỉ cách sửa lại cám ơn 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

NguyenNgocSon    43

NguyenNgocSon
Đã đăng

Khai báo biến toàn cục:

Public Diembatdau As Variant
Public mss As Double
mss = InputBox("Nhap vao MSS", "Nguyen Ngoc Son")
Diembatdau = ThisDrawing.Utility.GetPoint(, "Chon diem bat dau ve tren man hinh:")

Mình khai báo biến toàn cục như này báo lỗi

Xin các bác chỉ giáo

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

huunhantvxdts    195

huunhantvxdts
Đã đăng

Khai báo biến toàn cục:

Public Diembatdau As Variant
Public mss As Double
mss = InputBox("Nhap vao MSS", "Nguyen Ngoc Son")
Diembatdau = ThisDrawing.Utility.GetPoint(, "Chon diem bat dau ve tren man hinh:")

Mình khai báo biến toàn cục như này báo lỗi

Xin các bác chỉ giáo

trong clip minh thấy bạn làm được rồi mà có gì chưa được bạn cứ trao đổi

  • 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

huunhantvxdts    195

huunhantvxdts
Đã đăng

Đã hoàn thiện một số nội dung để ngày càng hoàn thiện hơn, mong mọi người góp ý thêm (sao nhiều người vào xem vậy mà không ai cho ý kiến, có ai đã dùng không vậy???)

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

huunhantvxdts    195

huunhantvxdts
Đã đăng

 

Link hỏng rồi, bạn gửi lại được không ?

Link mới đây bạn nè có chi không không hiểu bạn cứ hỏi

bạn chạy office 2003 và cad2008 nhé nhớ mở file cad đi kèm trước hi

http://www.cadviet.com/upfiles/3/66960_ve_cong.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

duongts    0

duongts
Đã đăng

Sao không ai có ý kiến gì nhỉ????

mình còn 1 thắc mắc nữa là làm sao để khi xuất sang cad các chữ số đều lấy 2 chữ số lẻ

mong các cao thủ chỉ cách sửa lại cám ơn nhiều

thoi gang tu tim di roi up len tiep

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

quoctien.tedi    0

quoctien.tedi
Đã đăng

Chào Bạn huunhantvxdts !

Hôm nay qua trang cadviet minh được biết Bạn. Chúc Bạn tối thứ 7 có nhiều niềm vui.

Mình rất vui khi Bạn gửi cho mình file vẽ trắc dọc demo qua vba để mình tham khảo.

Vì mình download không được. Rất cam ơn Ban. Email của mình: quoctien.tedi@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

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
Đăng nhập để thực hiện theo  
Người theo dõi 0
Về Đầu Trang Lập trình khác
×