Đến nội dung


Hình ảnh
- - - - -

Các bác check hộ em xem VBA của em sai ở đâu.


  • Please log in to reply
11 replies to this topic

#1 yuduy

yuduy

    Chưa sử dụng CAD

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

Đã gửi 23 January 2010 - 11:18 AM

Em có viết thử 1 đoạn VBA để tính cao độ trong cad như sau:

Public Sub Tinh_cao_do()
Dim bl1, bl2 As AcadText
Dim m, n, i, d As Integer
Dim ss1, ss2 As AcadSelectionSet
Dim point0 As Variant
On Error Resume Next

point0 = ThisDrawing.Utility.GetPoint(, "chon diem cao do goc")

ThisDrawing.Utility.Prompt "chon text cao do goc"
Set ss1 = ThisDrawing.SelectionSets.Add("New1")
ss1.SelectOnScreen
Set m = bl1.TextString
ss1.Delete

n = InputBox("So diem can tinh cao do")

For i = 1 To n
pointi = ThisDrawing.Utility.GetPoint(, "chon diem can tinh cao do")
d = point0(1) - pointi(1)

ThisDrawing.Utility.Prompt "chon text hien thi"
Set ss2 = ThisDrawing.SelectionSets.Add("New2")
ss2.SelectOnScreen
For Each bl2 In ss2
bl2.TextString = Format(m - d, "0.00")
bl2.Update
bl2.color = acMagenta
Next
ss2.Delete
Next
End Sub

Không hiểu đoạn chọn text cao độ gốc có sai đâu không mà khi chạy, sau khi chọn point cao độ gốc rồi, nó nhảy sang luôn bước InputBox("So diem can tinh cao do")
luôn, không có bước chọn Text để nhận làm cao độ gốc. Em chuyển sang kiểu này thì được (nhưng kiểu này hơi khó chịu vì phải nhập cao độ gốc):

Public Sub Tinh_cao_do()
Dim bl1, bl2 As AcadText
Dim m, n, i, d As Integer
Dim ss1, ss2 As AcadSelectionSet
Dim point0 As Variant
On Error Resume Next

point0 = ThisDrawing.Utility.GetPoint(, "chon diem cao do goc")

m = InputBox("Nhap cao do goc")

n = InputBox("So diem can tinh cao do")

For i = 1 To n
pointi = ThisDrawing.Utility.GetPoint(, "chon diem can tinh cao do")
d = point0(1) - pointi(1)

ThisDrawing.Utility.Prompt "chon text hien thi"
Set ss2 = ThisDrawing.SelectionSets.Add("New2")
ss2.SelectOnScreen
For Each bl2 In ss2
bl2.TextString = Format(m - d, "0.00")
bl2.Update
bl2.color = acMagenta
Next
ss2.Delete
Next
End Sub

Kiểu này phải nhập cao độ gốc bằng phím, lại có bảng Inbox hiện lên nên không pan zoom được, nhiều khi trong phạm vi màn hình không có Text cao độ gốc thì lại phải ESC pan zoom để xem rồi chạy lại, hơi bất tiện.

Thêm nữa là phải đếm số điểm cần tính cao độ để nhập cho giá trị n, có cách nào không phải nhập mà cứ chọn point cần tính, text hiển thị, rồi lại point cần tính thứ 2, text hiển thị thứ 2, ... bao giờ xong hết các điểm cần tính thì bấm gì đó để kết thúc lệnh không các bác ?

Các bác chỉ giúp em với.
  • 0

#2 anhcos

anhcos

    biết lệnh hatchedit

  • Advance Member
  • PipPipPipPip
  • 260 Bài viết
Điểm đánh giá: 170 (tàm tạm)

Đã gửi 23 January 2010 - 06:20 PM

...
point0 = ThisDrawing.Utility.GetPoint(, "chon diem cao do goc")

ThisDrawing.Utility.Prompt "chon text cao do goc"
Set ss1 = ThisDrawing.SelectionSets.Add("New1")
ss1.SelectOnScreen
Set m = bl1.TextString
ss1.Delete

n = InputBox("So diem can tinh cao do")

...

Thay dòng màu đỏ như sau:
m = Val(ss1.Item(0).TextString) 'Lấy đối tượng dc chọn đầu tiên, sau đó chuyển số thành chuỗi
  • 1
Clear sky!

MF Rock collection.

#3 yuduy

yuduy

    Chưa sử dụng CAD

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

Đã gửi 24 January 2010 - 04:28 PM

Cảm ơn bác, được rồi :undecided:
Có cái nữa hỏi bác luôn là code nào để nhập số điểm cần tính n mà nó hỏi ở dưới Command bar rồi nhập dưới đó luôn chứ không phải dùng inputbox như em đang làm không ạ ? Vì inputbox nó hiện lên bảng để nhập, không pan zoom được hơi bất tiện. Hoặc làm sao để không phải nhập n, chỉ việc chọn các điểm cần tính, thích ngắt lệnh ở đâu thì ngắt không ạ ?
  • 0

#4 anhcos

anhcos

    biết lệnh hatchedit

  • Advance Member
  • PipPipPipPip
  • 260 Bài viết
Điểm đánh giá: 170 (tàm tạm)

Đã gửi 24 January 2010 - 08:11 PM

Dùng ThisDrawing.Utility.GetReal để nhập 1 số thực từ command line
  • 1
Clear sky!

MF Rock collection.

#5 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1436 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 26 January 2010 - 01:11 PM

................................
Thêm nữa là phải đếm số điểm cần tính cao độ để nhập cho giá trị n, có cách nào không phải nhập mà cứ chọn point cần tính, text hiển thị, rồi lại point cần tính thứ 2, text hiển thị thứ 2, ... bao giờ xong hết các điểm cần tính thì bấm gì đó để kết thúc lệnh không các bác ?
..........................

Đúng là số thành viên CadViet quan tâm đến VBA (đặc biệt là VBA for CAD) không nhiều.

Bạn yuduy đã đặt ra vấn đề :
- trong VBA làm cách nào không phải nhập số buớc lặp mà chỉ cần chọn point cần tính thứ 1, text hiển thị thứ 1, rồi lại point cần tính thứ 2, text hiển thị thứ 2, ... bao giờ xong hết các điểm cần tính thì bấm gì đó để kết thúc lệnh (ESC hay Enter chẳng hạn)

Vấn đề này với LISP đúng là chuyện nhỏ, nhưng với VBA lại là chuyện lớn.
(đó cũng là nguyên nhân dẫn đến chuyện tui chia tay VBA for CAD vài năm truớc)

Để giải quyết vấn đề này, tui đưa vào vòng lặp với D/kiện lặp : đối tuợng chọn = TEXT, tuy nhiên nhuợc điểm của nó là User phải chọn 1 đối tuợng khác TEXT thì mới thoát khỏi vòng lặp đuợc.

ThisDrawing.Utility.GetEntity ent, pt, vbCrLf & "Chon text can cap nhat : "
Do While ent.ObjectName = "AcDbText"
...................
ThisDrawing.Utility.GetEntity ent, pt, vbCrLf & "Chon text can cap nhat : "
Loop

Các bạn cho hỏi trong T/hợp này có thể dùng phím ESC hay Enter để thoát ra vòng lặp đuợc không ?
Cám ơn nhiều.
Public Sub Tinh_cao_do()
Dim ent As AcadEntity
Dim point0, pointi, pt As Variant
Dim chenh_cao, caodogoc As Double

On Error Resume Next

point0 = ThisDrawing.Utility.GetPoint(, vbCrLf & "Chon diem cao do goc : ")

ThisDrawing.Utility.GetEntity ent, pt, vbCrLf & "Chon text cao do goc : "
'Kiem tra ent la doi tuong Text
Do While ent.ObjectName <> "AcDbText"
ThisDrawing.Utility.GetEntity ent, pt, vbCrLf & "Chon text cao do goc : "
Loop

caodogoc = Val(ent.TextString)

ThisDrawing.Utility.GetEntity ent, pt, vbCrLf & "Chon text can cap nhat : "

Do While ent.ObjectName = "AcDbText"
pointi = ThisDrawing.Utility.GetPoint(point0, vbCrLf & "Chon diem can tinh cao do : ")
chenh_cao = point0(1) - pointi(1)
ent.TextString = Format(caodogoc - chenh_cao, "0.000")
ent.color = acMagenta
ThisDrawing.Utility.GetEntity ent, pt, vbCrLf & "Chon text can cap nhat : "
Loop

End Sub

  • 0

#6 anhcos

anhcos

    biết lệnh hatchedit

  • Advance Member
  • PipPipPipPip
  • 260 Bài viết
Điểm đánh giá: 170 (tàm tạm)

Đã gửi 26 January 2010 - 02:23 PM

Thực ra từ trước đến giờ tôi cũng chưa hề viết một VBA nào cho AutoCAD cả.
Với VS Studio, lập trình cho CAD thực sự dễ dàng, vì dù sao nó vẫn là ngôn ngữ cấp cao, sáng sủa và dễ hiểu.
LISP tôi không còn dùng hơn 10 năm này.
Tuy nhiên ngôn ngữ nào chỉ là cách thể hiện, thuật giải là quan trọng nhất.

Lặp lại việc nhập và kết thúc với Esc or Enter

Dim ent As AcadEntity
ThisDrawing.Utility.GetEntity ent, pt, vbCrLf & "Chon text can cap nhat : "

Do While ent.ObjectName = "AcDbText"
On Error GoTo cho_no_thoi
ThisDrawing.Utility.GetEntity ent, pt, vbCrLf & "Chon text can cap nhat : "
Loop

cho_no_thoi:
  • 2
Clear sky!

MF Rock collection.

#7 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1436 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 26 January 2010 - 03:29 PM

Thực ra từ trước đến giờ tôi cũng chưa hề viết một VBA nào cho AutoCAD cả.
Với VS Studio, lập trình cho CAD thực sự dễ dàng, vì dù sao nó vẫn là ngôn ngữ cấp cao, sáng sủa và dễ hiểu.
LISP tôi không còn dùng hơn 10 năm này.
Tuy nhiên ngôn ngữ nào chỉ là cách thể hiện, thuật giải là quan trọng nhất.

Lặp lại việc nhập và kết thúc với Esc or Enter

Dim ent As AcadEntity
ThisDrawing.Utility.GetEntity ent, pt, vbCrLf & "Chon text can cap nhat : "

Do While ent.ObjectName = "AcDbText"
On Error GoTo cho_no_thoi
ThisDrawing.Utility.GetEntity ent, pt, vbCrLf & "Chon text can cap nhat : "
Loop

cho_no_thoi:

Autodesk đã ngưng cung cấp VBA từ CAD 2010 (chỉ có thể down từ Web), tuơng lai là .NET nhưng vì vấn đề bản quyền đành ngậm ngùi đứng nhìn.
Hy vọng trong tuơng lai gần Autodesk sẽ cung cấp Visual Studio Tools for Applications (VSTA) kèm với bộ đĩa cài đặt.

Cám ơn sự hướng dẫn của bác.
  • 0

#8 ptlong04x1

ptlong04x1

    biết vẽ polygon

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

Đã gửi 30 January 2010 - 10:27 PM

Lặp lại việc nhập và kết thúc với Esc or Enter

Dim ent As AcadEntity
ThisDrawing.Utility.GetEntity ent, pt, vbCrLf & "Chon text can cap nhat : "

Do While ent.ObjectName = "AcDbText"
On Error GoTo cho_no_thoi
ThisDrawing.Utility.GetEntity ent, pt, vbCrLf & "Chon text can cap nhat : "
Loop

cho_no_thoi:


Mình đang bắt đầu tìm hiểu VBA cho CAD và quả thật thấy nó rất hay, hy vọng mọi người bỏ thêm thời gian nghiên cứu để box hoạt động sôi nổi hơn.
Tiếp chủ đề này, mình thấy .GetEntity sẽ báo lỗi khi không chọn đối tượng. Với cách gắn nhãn Cho_no_thoi:, lúc ta nhấn Esc hay Pick chuột vào chỗ trống trên ModelSpace thì đều thoát khỏi SUB. Mình thấy như vậy thì hơi khó chịu bởi vì có thể người dùng sơ ý Pick không trúng đối tượng nào cả thì cũng thoát SUB luôn. Mình muốn hỏi có cách nào để chỉ khi nhấn Esc thì mới thoát còn Pick vào chỗ trống thì không thoát hay không?, mong mọi người xem giúp. Xin cảm ơn!
  • 0

#9 anhcos

anhcos

    biết lệnh hatchedit

  • Advance Member
  • PipPipPipPip
  • 260 Bài viết
Điểm đánh giá: 170 (tàm tạm)

Đã gửi 30 January 2010 - 10:43 PM

Mình đang bắt đầu tìm hiểu VBA cho CAD và quả thật thấy nó rất hay, hy vọng mọi người bỏ thêm thời gian nghiên cứu để box hoạt động sôi nổi hơn.
Tiếp chủ đề này, mình thấy .GetEntity sẽ báo lỗi khi không chọn đối tượng. Với cách gắn nhãn Cho_no_thoi:, lúc ta nhấn Esc hay Pick chuột vào chỗ trống trên ModelSpace thì đều thoát khỏi SUB. Mình thấy như vậy thì hơi khó chịu bởi vì có thể người dùng sơ ý Pick không trúng đối tượng nào cả thì cũng thoát SUB luôn. Mình muốn hỏi có cách nào để chỉ khi nhấn Esc thì mới thoát còn Pick vào chỗ trống thì không thoát hay không?, mong mọi người xem giúp. Xin cảm ơn!


Dùng Select/SelectOnScreen của đối tượng SelectionSet, kèm với filter riêng cho từng đối tượng/layer/color...
Khi đó phím esc/enter để kết thúc việc chọn đối tượng.
  • 1
Clear sky!

MF Rock collection.

#10 ptlong04x1

ptlong04x1

    biết vẽ polygon

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

Đã gửi 30 January 2010 - 11:07 PM

Dùng Select/SelectOnScreen của đối tượng SelectionSet, kèm với filter riêng cho từng đối tượng/layer/color...
Khi đó phím esc/enter để kết thúc việc chọn đối tượng.


Bạn có thể viết giùm mình 1 đoạn code ví dụ không, cụ thể là :
Ra thông báo yêu cầu người dùng chọn 1 đối tượng Line, nếu người dùng chọn đối tượng khác Line hay Pick vào chỗ trống trên màn hình thì đưa thông báo : "Bạn chọn sai, vui lòng chọn 1 đường thẳng!", cho đến khi người dùng chọn 1 Line hay nhấn Esc thì thoát SUB. Cảm ơn bạn trước!
  • 0

#11 anhcos

anhcos

    biết lệnh hatchedit

  • Advance Member
  • PipPipPipPip
  • 260 Bài viết
Điểm đánh giá: 170 (tàm tạm)

Đã gửi 31 January 2010 - 08:17 AM

VD: để chọn các Circle
Sub Example_SelectCircle()	  
' This example adds objects to a selection set by identifying a point.
' At first all objects at the point are added to the selection set. Then
' only circle objects at the point are added to the selection set.
' Create the selection set
Dim ssetObj As AcadSelectionSet
On error resume next
Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_SSET1")
if error <> 0 then
Set ssetObj = ThisDrawing.SelectionSets.Item("TEST_SSET1")
end if

Dim gpCode(0) As Integer
Dim dataValue(0) As Variant

gpCode(0) = 0
dataValue(0) = "Circle"
Dim groupCode As Variant, dataCode As Variant
groupCode = gpCode
dataCode = dataValue
ssetObj.SelectOnScreen groupCode, dataCode
End Sub


VD: Để chọn vừa Line vừa Circle và các Text có textstyle là "VNI_toithich"

Sub Example_SelectLineCircle()
' Create the selection set
Dim ssetObj As AcadSelectionSet
On error resume next
Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_SSET1")
if error <> 0 then
Set ssetObj = ThisDrawing.SelectionSets.Item("TEST_SSET1")
end if

Dim gpCode(7) As Integer
Dim dataValue(7) As Variant

gpCode(0) = -4
dataValue(0) = "
gpCode(1) = 0
dataValue(1) = "CIRCLE"

gpCode(2) = -4
dataValue(2) = "
gpCode(3) = 0
dataValue(3) = "TEXT"

gpCode(4) = 7
dataValue(4) = "VNI_toithich"

gpCode(5) = -4
dataValue(5) = "and>"

gpCode(6) = 0
dataValue(6) = "LINE"

gpCode(7) = -4
dataValue(7) = "or>"

Dim groupCode As Variant, dataCode As Variant
groupCode = gpCode
dataCode = dataValue

ssetObj.SelectOnScreen groupCode, dataCode
End Sub

  • 1
Clear sky!

MF Rock collection.

#12 lovemycountry

lovemycountry

    biết pan

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

Đã gửi 01 February 2010 - 12:41 PM

có thể dùng lệnh GetEntity để chọn 1 đối tượng
Dim ALine as Object, pp as Variant
On Error Resume Next
Do
ThisDrawing.Utility.GetEntity ALine, pp, "Chon duong line:"
If Err then
Err.Clear
ElseIf ALine.ObjectName = "AcDbLine" Then
Exit Do
EndIf
MsgBox "Ban phai chon duong Line"
Loop Until False

  • 0