Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
29 replies to this topic

#1 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 12 December 2011 - 08:43 AM

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.c...e_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....h?v=cjwuUw3sx5I

Similar topics from web:
VBA
Thảo luận về Autolisp

  • 5

#2 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 12 December 2011 - 09:06 AM

Ứ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 :)
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 12 December 2011 - 10:19 AM

Ứ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
  • 1

#4 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 12 December 2011 - 10:30 AM

Ở 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 ^^
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#5 phantuhuong

phantuhuong

    biết dimstyle

  • Moderator
  • PipPipPipPipPip
  • 383 Bài viết
Điểm đánh giá: 200 (khá)

Đã gửi 12 December 2011 - 12:21 PM

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.
  • 0
Bồi dưỡng Excel & VBA cho các đơn vị ở Hà Nội và khu vực lân cận

Từng bước loại đồ Tàu ra khỏi cuộc sống!


#6 Detailing

Detailing

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 667 Bài viết
Điểm đánh giá: 278 (khá)

Đã gửi 12 December 2011 - 01:08 PM

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!
  • 0

Ideas don't matter, execution does!

1908412_308002392716743_8165279281236341


#7 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 12 December 2011 - 01:43 PM

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
  • 0

#8 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 12 December 2011 - 01:56 PM

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.
  • 0

#9 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 21 December 2011 - 08:23 AM

Ứ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???
  • 0

#10 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 21 December 2011 - 08:30 AM

Bạn thử để
objAcadApp.Visible = True
objAcadApp.WindowState = acMax
xem sao
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#11 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 21 December 2011 - 10:05 AM

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 ,)
  • 0

#12 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 17 February 2012 - 04:35 PM

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
  • 0

#13 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 06 March 2012 - 10:15 AM

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
  • 0

#14 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 21 March 2012 - 01:42 PM

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
  • 1

#15 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 21 March 2012 - 02:08 PM

Cám ơn bác. Cái yêu cầu này mình post khá lâu rồi đã giải quyết xong thân !
  • 0

#16 kj3mma

kj3mma

    biết vẽ circle

  • Members
  • PipPip
  • 38 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 21 March 2012 - 03:13 PM

chủ thớt có thể quay clip để anh em biết thao tác thực hiện sẽ nhanh hơn không
  • 0

#17 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 20 August 2012 - 04:52 PM

Đã 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???)
  • 0

#18 soluuhuong2903

soluuhuong2903

    biết vẽ rectang

  • Members
  • PipPip
  • 87 Bài viết
Điểm đánh giá: 22 (tàm tạm)

Đã gửi 20 August 2012 - 05:02 PM

Tối về e dùng thử.em sẽ feedback cho bác sau.hehe.đang cần cái này.
  • 0

#19 lenhatanh

lenhatanh

    biết vẽ polygon

  • Members
  • PipPip
  • 75 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 11 October 2012 - 09:01 AM

...
Đây là link down mới
http://www.4shared.c...e_cong_moi.html


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

#20 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 17 October 2012 - 10:58 AM


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.c...960_ve_cong.rar
  • 0