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

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

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

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

yuduy    0

yuduy
Đã đăng

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.

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

anhcos    196

anhcos
Đã đăng

...

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

  • 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

yuduy    0

yuduy
Đã đăng

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 ạ ?

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

gia_bach    1.549

gia_bach
Đã đăng
................................

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

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

anhcos    196

anhcos
Đã đăng

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:

  • Vote tăng 2

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

gia_bach    1.549

gia_bach
Đã đăng
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.

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

ptlong04x1    8

ptlong04x1
Đã đăng
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!

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

anhcos    196

anhcos
Đã đăng
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.

  • 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

ptlong04x1    8

ptlong04x1
Đã đăng
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!

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

anhcos    196

anhcos
Đã đăng

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

  • 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

lovemycountry    1

lovemycountry
Đã đăng

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

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
×