Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
lucton

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

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

dvdcad    1

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

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
Jin Yong    334
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!

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
lucton    0
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:

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
khacsau    0
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é..

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

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.yousendit.com/621579059/d2fb6b...13b686f1407b509

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
Who am I    1
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.yousendit.com/621579059/d2fb6b...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.

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

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!

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
Phiphi-    175
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.com/upfiles/Drawing_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.

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
ndtnv    397
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

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

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

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

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

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
Phiphi-    175
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.com/upfiles/Drawing_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.

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
amateurday    4

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.

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

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.com/upfiles/phuongtrinhbacnhat.dvb

Mong các bác 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
Nguyen Hoanh    4.524

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

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

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

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
ndtnv    397

nho cac bac fix giup em

 

'''''''''''''''''''''''''''''''''''''''''''''''''

' SU LY GIUP TOI PHAN NAY NHE

' Toi muon lan dau tien thi xuat hien dong nay de nguoi dung nhap duong dan

' nhung lan sau thuc hien lenh se khong xuat hien dong nay nua ma duong dan lay tu lan nhap dau tien

'nhap duong dan

pathht = ThisDrawing.Utility.GetString(True, " Nhap duong dan (Enter de ket thuc): ")

 

''''''''''''''''''''''''''''''''''''''''''''''''''

toi

A Khai báo biến:

Cách 1: chỉ dùng cho hàm này

 

Static pathht As String

 

Cách 2: biến pathht dùng chung thì khai báo bên ngoài hàm

 

Public pathht As String

Sub wblock_bacbk()

...

End Sub

 

B Trong sub đặt dòng lệnh lấy path vào trong if

 If pathht = "" Then
 pathht = ThisDrawing.Utility.GetString(True, " Nhap duong dan (Enter de ket thuc): ")
End If

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

Cảm ơn bác đã giúp đỡ. Tôi làm như bác nhưng chưa được. ý của tôi là bác sửa đoạn code đó như thế nào cũng được kể cả hiện hộp thoại để người dùng nhập đường dẫn. nếu đánh lệnh lần đầu tiên thì ok nhưng tôi muốn là lần thứ 2 dùng lại lệnh đó không phải nhập đường dẫn nữa. ( nghĩa là các lần tiếp theo không xuất hiện dòng nhập đường dẫn nữa. đường dẫn sẽ lấy bằng đường dẫn trong lần wblock đầu tiên). Các bác có thể sửa trên code tôi up lên rồi send cho tôi được 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
ndtnv    397
Sub wblock_bacbk()

' Tao doi tuong SelectionSet

Dim ssetObj As AcadSelectionSet

Static pathht As String

Dim filename As String

Dim duongdan As String

 

On Error Resume Next

Set ssetObj = ThisDrawing.SelectionSets("bacbkselect")

If Err <> 0 Then

Err.Clear

Set ssetObj = ThisDrawing.SelectionSets.Add("bacbkselect")

Else

ssetObj.SelectOnScreen

End If

 

'''''''''''''''''''''''''''''''''''''''''''''''''

' SU LY GIUP TOI PHAN NAY NHE

' Toi muon lan dau tien thi xuat hien dong nay de nguoi dung nhap duong dan

' nhung lan sau thuc hien lenh se khong xuat hien dong nay nua ma duong dan lay tu lan nhap dau tien

'nhap duong dan

If pathht = "" Then

pathht = ThisDrawing.Utility.GetString(True, " Nhap duong dan (Enter de ket thuc): ")

End If

''''''''''''''''''''''''''''''''''''''''''''''''''

'nhap ten file

filename = ThisDrawing.Utility.GetString(True, " Nhap ten file (Enter de ket thuc): ")

 

duongdan = pathht & "\" & filename

 

ThisDrawing.Wblock duongdan, ssetObj

 

ssetObj.Erase

 

End Sub

  • 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
minhtu2004    35

Xin mọi người giúp đỡ. Mình có 1 VBA khi chạy cad báo lỗi như hình sau:http://www.cadviet.com/upfiles/1_14.bmp.

và đây là file VBA:http://www.cadviet.com/upfiles/Copy.vbs. Nhờ mọi người 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

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


×