Đến nội dung


Hình ảnh
- - - - -

Viết VBA theo yêu cầu.............


  • Please log in to reply
124 replies to this topic

#1 lucton

lucton

    biết pan

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

Đã gửi 28 June 2008 - 11:54 AM

Mời các bạn đưa ra các yêu cầu viết các hàm VBA trong Autocad để các thành viên đưa lên
  • 0

#2 dvdcad

dvdcad

    biết vẽ arc

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

Đã gửi 13 July 2008 - 04:01 PM

các bạn sửa giúp mình cái lỗi này. mình viết bằng VBA khi thực hiện lệnh trên cad thì báo như thế này nhưng vẫn ra form. các bạn sửa cho nó ra chữ Nil dc ko
Command: _vbaman Initializing VBA System...
Command:
Command:
Command: _vbaman
Command:
Command:
Command: _gt Execution errornil

  • 0

#3 dvdcad

dvdcad

    biết vẽ arc

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

Đã gửi 13 July 2008 - 11:12 PM

sao ko có bác nào giúp minh hả
  • 0

#4 Jin Yong

Jin Yong

    biết lệnh group

  • Vip
  • PipPipPipPipPipPip
  • 498 Bài viết
Điểm đánh giá: 334 (khá)

Đã gửi 14 July 2008 - 08:21 AM

sao ko có bác nào giúp minh hả

Tốt nhất là bạn nên gửi cho mọi người xem thử chương trình của bạn, để mọi người dễ dàng khắc phục hơn!
  • 0

Phát triển phần mềm thiết kế Kết cấu Việt Nam - http://www.ketcausoft.com


#5 lucton

lucton

    biết pan

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

Đã gửi 15 August 2008 - 12:07 AM

các bạn sửa giúp mình cái lỗi này. mình viết bằng VBA khi thực hiện lệnh trên cad thì báo như thế này nhưng vẫn ra form. các bạn sửa cho nó ra chữ Nil dc ko
Command: _vbaman Initializing VBA System...
Command:
Command:
Command: _vbaman
Command:
Command:
Command: _gt Execution errornil


Do thiếu file thư viện khi cài
cài lại Cad
Nếu ko được cài lại Win sau đó cài lại Cad là OK
:s_big:
  • 0

#6 khacsau

khacsau

    biết pan

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

Đã gửi 01 October 2008 - 09:10 AM

Do thiếu file thư viện khi cài
cài lại Cad
Nếu ko được cài lại Win sau đó cài lại Cad là OK
:cheers:

Em chào các anh!
Em mới dùng CAD. Các anh cho em hỏi chút là em có những bản vẽ mà 1 file có nhiều Layout vậy thì làm như thế nào để in toàn bộ các Layout đó. Nếu chọn từng Layout rồi chọn lệnh in thì nông dân quá. Mong các anh chị giúp đỡ. Em cảm ơn nhé..
  • 0

#7 huutruongdt123

huutruongdt123

    biết zoom

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

Đã gửi 04 November 2008 - 12:55 PM

Xin lỗi mình lại vừa tạo topic thì mới nhận ra có topic viết VBA theo yêu cầu. Mình viết lại yêu cầu ở đây mong mọi người giúp đỡ.
Hiện tại tôi có 1 file VBA và file Excel (không rõ do ai viết). Tác dụng của file VBA là lấy dữ liệu từ sheet của file Excel rồi vẽ trên Cad. Nhưng file VBA này lúc chạy được, lúc không; có máy chạy được có máy không (chẳng hiểu tại sao nó thế nữa vì tôi mù tịt về ngôn ngữ lập trình). Hơn thế để chạy được chương trình thì nó đòi hỏi chuyển thời gian của máy về năm 1998 còn để năm khác thì nó không chạy.
Vì vậy tôi xin nhờ các A/C trên diễn đàn xem giúp có thể chỉnh sửa được file VBA này không. Sao cho nó luôn chạy được với mọi máy và không cần đặt lại thời gian của máy tính cũng chạy được.
Cảm ơn mọi người đã giúp đỡ.
Dưới đây là link file VBA và file Excel đi kèm
http://rcpt.yousendi...13b686f1407b509
  • 0

#8 Who am I

Who am I

    biết vẽ line

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

Đã gửi 04 November 2008 - 02:36 PM

Xin lỗi mình lại vừa tạo topic thì mới nhận ra có topic viết VBA theo yêu cầu. Mình viết lại yêu cầu ở đây mong mọi người giúp đỡ.
Hiện tại tôi có 1 file VBA và file Excel (không rõ do ai viết). Tác dụng của file VBA là lấy dữ liệu từ sheet của file Excel rồi vẽ trên Cad. Nhưng file VBA này lúc chạy được, lúc không; có máy chạy được có máy không (chẳng hiểu tại sao nó thế nữa vì tôi mù tịt về ngôn ngữ lập trình). Hơn thế để chạy được chương trình thì nó đòi hỏi chuyển thời gian của máy về năm 1998 còn để năm khác thì nó không chạy.
Vì vậy tôi xin nhờ các A/C trên diễn đàn xem giúp có thể chỉnh sửa được file VBA này không. Sao cho nó luôn chạy được với mọi máy và không cần đặt lại thời gian của máy tính cũng chạy được.
Cảm ơn mọi người đã giúp đỡ.
Dưới đây là link file VBA và file Excel đi kèm
http://rcpt.yousendi...13b686f1407b509

Em kích vào liên kết trên và nhận được thông báo:
This download link is invalid and there is no file associated with it.
Anh có thể post lại vào trang lưu trữ trực tuyến khác được không, ví dụ mediafire chẳng hạn.
  • 0

#9 huutruongdt123

huutruongdt123

    biết zoom

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

Đã gửi 04 November 2008 - 06:04 PM

Cảm ơn bạn đã quan tâm gúp đỡ. Link trên mình vẫn download được, nếu vẫn không được bạn có thể download ở link sau:
http://www.mediafire...2db6fb9a8902bda
Mong sớm có phản hồi.
  • 0

#10 nkgedadknr

nkgedadknr

    biết vẽ line

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

Đã gửi 19 November 2008 - 09:17 AM

Mình muốn viết 1 sub DrawLine dùng để vẽ 1 Line or 1 PolyLine kèm theo xuất chiều dài và gán lớp cho entity này. sau đó trong các Sub khác mình sẽ gọi lại sub DrawLine này.
Đây là code:
Private Sub DrawLine()
Dim varStart, varEnd As Variant
Dim objEnt As AcadLine

On Error Resume Next


If ThisDrawing.ActiveSpace = acModelSpace Then
Set objEnt = ThisDrawing.ModelSpace.AddLine(varStart, varEnd)
Else
Set objEnt = ThisDrawing.PaperSpace.AddLine(varStart, varEnd)
End If
objEnt.Update
End With

End Sub
Còn ở các Sub kia thì mình gọi DrawLine() như sau
With ThisDrawing.Utility
point1 = .GetPoint(, vbCr & "Pick Start point: ")
point2 = .GetPoint(point1, vbCr & "Pick End point: ")
[b]Call DrawLine()[/b]
nhưng nó báo error ???

Anh em check dùm mình? và chỉ mình cách viết 1 sub kiểu như thế có giống viết 1 hàm Function hay không?
Mình programmer ABC lắm
Thanks for help!
  • 0

#11 Phiphi-

Phiphi-

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 434 Bài viết
Điểm đánh giá: 175 (tàm tạm)

Đã gửi 28 November 2008 - 09:03 PM

Mời các bạn đưa ra các yêu cầu viết các hàm VBA trong Autocad để các thành viên đưa lên

Cám ơn các Bác đã tạo topic này.
PP nhờ các Bác viết giúp hàm VBA dùng để tạo nhanh các hyperlink trong bảng Excel đã có sẳn các đường dẩn của các bản vẽ.
Vì có số lượng rất nhiều bản vẽ đã được lưu trong các folder khác nhau và trong các ổ dĩa cũng khác nhau trên hệ thống mạng.
Nhưng nếu tận dụng chức năng của Hyperlink trong Excel, Word thì việc mở bản vẽ để xem nhanh chóng rất nhiều.
PP có tạo 1 bảng Excel có 2 sheet:
+ Sheet 1 là chi tiết các đường dẩn của các bản vẽ đã được lưu trong các folder khác nhau
+ Sheet 2: sau khi dùng hàm VBA thì các đường dẩn được làm thành các Hyperlink, chỉ cần nhấp chuột vào đó thì sẽ mở xem bản vẽ ngay lập tức.
http://www.cadviet.c...awing_index.zip
Các bản vẽ thí dụ được PP lưu và nén lại, các Bác giải nén vào ổ dĩa C:\ rồi mở filename Drawing index.xls
(Sheet 2 được làm thủ công nên chỉ có vài link để làm thí dụ mà thôi)
Xin cám ơn trước.
  • 0

#12 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 10 December 2008 - 03:15 PM

Mình muốn viết 1 sub DrawLine dùng để vẽ 1 Line or 1 PolyLine kèm theo xuất chiều dài và gán lớp cho entity này. sau đó trong các Sub khác mình sẽ gọi lại sub DrawLine này.
Đây là code:

Private Sub DrawLine()
Dim varStart, varEnd As Variant
Dim objEnt As AcadLine

On Error Resume Next
If ThisDrawing.ActiveSpace = acModelSpace Then
Set objEnt = ThisDrawing.ModelSpace.AddLine(varStart, varEnd)
Else
Set objEnt = ThisDrawing.PaperSpace.AddLine(varStart, varEnd)
End If
objEnt.Update
End With

End Sub
Còn ở các Sub kia thì mình gọi DrawLine() như sau
With ThisDrawing.Utility
point1 = .GetPoint(, vbCr & "Pick Start point: ")
point2 = .GetPoint(point1, vbCr & "Pick End point: ")
[b]Call DrawLine()[/b]
nhưng nó báo error ???

Anh em check dùm mình? và chỉ mình cách viết 1 sub kiểu như thế có giống viết 1 hàm Function hay không?
Mình programmer ABC lắm
Thanks for help!

Bạn xem help, example VBA của acad để biết cách viết sub hay Function
Hàm của bạn sửa lại như sau
Private Sub DrawLine(varStart As Variant, varEnd As Variant)
Dim objEnt As AcadLine

On Error Resume Next


If ThisDrawing.ActiveSpace = acModelSpace Then
Set objEnt = ThisDrawing.ModelSpace.AddLine(varStart, varEnd)
Else
Set objEnt = ThisDrawing.PaperSpace.AddLine(varStart, varEnd)
End If
objEnt.Update

End Sub

Sub TestDrawLine()
Dim point1 As Variant, point2 As Variant
With ThisDrawing.Utility
point1 = .GetPoint(, vbCr & "Pick Start point: ")
point2 = .GetPoint(point1, vbCr & "Pick End point: ")
Call DrawLine(point1, point2)
End With
End Sub

  • 0

#13 tiazu

tiazu

    biết zoom

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

Đã gửi 11 December 2008 - 01:25 PM

Mình cần 1 chương trình thay đổi tên blockkhông cần biết tên block cũ (click chọn hoặc chọn trước).
Trong CAD có lệnh REN để đổi tên nhưng phải nhớ tên block cũ (có khi rất dài dòng khó nhớ).
Bạn nào viết được cho mình xin (có code luôn càng tốt). Thanks
  • 0

#14 ngthuy

ngthuy

    Chưa sử dụng CAD

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

Đã gửi 07 January 2009 - 02:23 PM

mình đang rất cần biết câu lệnh khi dùng VBA trong autocad như là:
câu lệnh để chuyển từ model sang layout space
và câu lệnh tạo viewport trong layout space.
xin hãy giúp mình.
mình xin cảm ơn
  • 0

#15 Phiphi-

Phiphi-

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 434 Bài viết
Điểm đánh giá: 175 (tàm tạm)

Đã gửi 20 January 2009 - 06:58 PM

Cám ơn các Bác đã tạo topic này.
PP nhờ các Bác viết giúp hàm VBA dùng để tạo nhanh các hyperlink trong bảng Excel đã có sẳn các đường dẩn của các bản vẽ.
Vì có số lượng rất nhiều bản vẽ đã được lưu trong các folder khác nhau và trong các ổ dĩa cũng khác nhau trên hệ thống mạng.
Nhưng nếu tận dụng chức năng của Hyperlink trong Excel, Word thì việc mở bản vẽ để xem nhanh chóng rất nhiều.
PP có tạo 1 bảng Excel có 2 sheet:
+ Sheet 1 là chi tiết các đường dẩn của các bản vẽ đã được lưu trong các folder khác nhau
+ Sheet 2: sau khi dùng hàm VBA thì các đường dẩn được làm thành các Hyperlink, chỉ cần nhấp chuột vào đó thì sẽ mở xem bản vẽ ngay lập tức.
http://www.cadviet.c...awing_index.zip
Các bản vẽ thí dụ được PP lưu và nén lại, các Bác giải nén vào ổ dĩa C:\ rồi mở filename Drawing index.xls
(Sheet 2 được làm thủ công nên chỉ có vài link để làm thí dụ mà thôi)
Xin cám ơn trước.

PP thấy nểu thêm đoạn text file:/// trước đường dẩn thì nó trở thành 1 hyperlink.
Bác nào biết thì vui lòng giải thích giúp. Thanks you.
  • 0

#16 amateurday

amateurday

    biết lệnh break

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

Đã gửi 31 March 2009 - 01:30 AM

em có 1 đường spline, bây giờ em muốn chia hắn ra nhiều đoạn không bằng nhau, và có thế đo được chiều dài của các đoạn cong đó thì làm thế nào ạ. mong các bác chỉ cho em.
  • 0

#17 thao_tedi

thao_tedi

    biết zoom

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

Đã gửi 05 April 2009 - 01:09 PM

Em làm một cái userform giải phương trình bậc nhất ax+b = 0. Code của user form như sau:

Public Sub OKcmd_Click()
Dim a As Double
Dim b As Double
Dim x As Double
a = CDbl(aso.Text)
b = CDbl(bso.Text)
If a = 0 Then
MsgBox "Phuong trinh vo nghiem" & vbCrLf & "De nghi nhap so vao bien a"
Else
x = (-1 * B ) / a
End If
xso.Text = x
End Sub
Private Sub Cancelcmd_Click()
Unload Me
End
End Sub

Em không biết cách khi nhập a, b là text thì sẽ xuất hiện thông báo lỗi và yêu cầu nhập lại và khi giải ra nghiệm thì sẽ không thể thay đổi giá trị ô chứa nghiệm đó (không cho phép thay đổi tetx box ghi nghiệm).
Link file dvb là: http://www.cadviet.c...rinhbacnhat.dvb
Mong các bác giúp đỡ!
  • 0

#18 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4106 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 06 April 2009 - 06:39 PM

Bạn sửa như sau:

Public Sub OKcmd_Click()
Dim a As Double
Dim b As Double
Dim x As Double

If Not IsNumeric(aso.Text) Then
MsgBox "Xem lai a"
aso.SetFocus
ElseIf Not IsNumeric(bso.Text) Then
MsgBox "Xem lai b"
bso.SetFocus
Else
a = CDbl(aso.Text)
b = CDbl(bso.Text)
If a = 0 Then
MsgBox "Phuong trinh vo nghiem" & vbCrLf & "De nghi nhap so vao bien a"
Else
x = (-1 * B ) / a
End If
xso.Text = x
End If
End Sub
Private Sub Cancelcmd_Click()
Unload Me
End
End Sub
  • 1

#19 thao_tedi

thao_tedi

    biết zoom

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

Đã gửi 07 April 2009 - 03:58 PM

Cám ơn bác nhiều lắm. Chúc bác mạnh khoẻ và gặp nhiều may mắn!
  • 0

#20 thao_tedi

thao_tedi

    biết zoom

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

Đã gửi 13 April 2009 - 12:51 PM

Em có một VBA vẽ Pline. Nhưng các Pline này không nối được với nhau. Các bác giúp em sửa VBA này để khi vẽ Pline thì nó sẽ nối các Pline riêng lẻ thành 1 Pline và khi nhập C thì nó nối với điểm đầu tiên tạo thành một Pline kín (như lệnh Pline trong AutoCAd thông thường).
Xin cám ơn các bác.!
Code VBA của e như sau:
Public Sub Diem()
Dim plineObj As AcadLWPolyline
Dim StPnt As Variant
Dim EdPnt As Variant
Dim prompt1 As String
Dim prompt2 As String
Dim Point(0 To 3) As Double
prompt1 = vbCrLf & " Enter a first point:"
prompt2 = vbCrLf & " Enter a second point:"
StPnt = ThisDrawing.Utility.GetPoint(, prompt1)
EdPnt = ThisDrawing.Utility.GetPoint(StPnt, prompt2)
Point(0) = StPnt(0): Point(1) = StPnt(1)
Point(2) = EdPnt(0): Point(3) = EdPnt(1)
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(Point)
StPnt = EdPnt
Retry:
On Error Resume Next
EdPnt = ThisDrawing.Utility.GetPoint(StPnt, vbCrLf & "Enter a next point: ")
If Err = 0 Then
Point(0) = StPnt(0): Point(1) = StPnt(1)
Point(2) = EdPnt(0): Point(3) = EdPnt(1)
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(Point)
Else
Err.Clear
GoTo endP
End If
StPnt = EdPnt
GoTo Retry
endP:
End Sub
  • 0