Đến nội dung


Hình ảnh
- - - - -

Quay đối tượng bằng VBA


  • Please log in to reply
3 replies to this topic

#1 phantuhuong

phantuhuong

    biết dimstyle

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

Đã gửi 25 October 2008 - 04:17 PM

Có 1 thành viên hỏi tôi cách quay đối tượng bằng VBA, thủ tục như sau:

Sub ObjectRotate()
Dim Obj As AcadEntity, Point As Variant
Dim Angle

'Xác định điểm gốc
Point = ActiveDocument.Utility.GetPoint(, "Chon diem goc: ")

'Chọn đối tượng để quay
ActiveDocument.Utility.GetEntity Obj, Point, "Chon doi tuong"
Obj.Highlight True 'Làm đối tượng sáng lên (chọn)

'Nhập góc quay theo độ, kiểm soát xem có bị lỗi nhập không?
Angle = InputBox("Nhap goc quay theo Do: ", "Chon doi tuong")
If Not IsNumeric(Angle) Then
MsgBox "Co loi"
Exit Sub
End If

'Quay đối tượng được chọn qua tâm
Obj.Rotate Point, Angle * 3.14 / 180

'Không chọn đối tượng nữa
Obj.Highlight False
Set Obj = Nothing
End Sub

Chúc vui vẻ!
  • 1
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!


#2 zoro107

zoro107

    biết vẽ ellipse

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

Đã gửi 14 September 2011 - 03:37 PM

ban cho hoi đoạn VBA này bị lỗi chỗ nào vậy

Sub ZoomWindow() 'su dung zoomwindow or Zoompickwindow
Msgbox"Perform a Zoom Window with:" &vbcrlf& "1.3,7.8,0" &vbcrlf&_
"13.7,-2.6,0",,"ZoomWindow"
Dim point1(0 To 2) As Double
Dim point2(0 To 2) As Double
point1(0) = 1.3: point1(1) = 7.8: point1(2) = 0
point2(0) = 13.7: point2(1) = -2.6: point2(2) = 0
ThisDrawing.Application.ZoomWindow point1, point2
'Zoom Pick Window
MsgBox "Perform a ZoomPickWindow", , "ZoomPickWindow"
ThisDrawing.Application.ZoomPickWindow
End Sub
  • 0

#3 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 14 September 2011 - 11:30 PM

ban cho hoi đoạn VBA này bị lỗi chỗ nào vậy

Sub ZoomWindow() 'su dung zoomwindow or Zoompickwindow
Msgbox"Perform a Zoom Window with:" &vbcrlf& "1.3,7.8,0" &vbcrlf&_
"13.7,-2.6,0",,"ZoomWindow"
Dim point1(0 To 2) As Double
Dim point2(0 To 2) As Double
point1(0) = 1.3: point1(1) = 7.8: point1(2) = 0
point2(0) = 13.7: point2(1) = -2.6: point2(2) = 0
ThisDrawing.Application.ZoomWindow point1, point2
'Zoom Pick Window
MsgBox "Perform a ZoomPickWindow", , "ZoomPickWindow"
ThisDrawing.Application.ZoomPickWindow
End Sub

Bạn bị sai chỗ màu đỏ. Sửa lại như sau
Msgbox"Perform a Zoom Window with:" & vbcrlf & "1.3,7.8,0" & vbcrlf & _
(có dấu cách giữa chữ &)
chú ý: Nếu dùng ZoomWindow thì thôi dùng ZoomPickWindow và ngược lại.
  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#4 nqt266

nqt266

    biết vẽ circle

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

Đã gửi 15 September 2011 - 12:42 PM

Cảm ơn bác, Xin hỏi bác lệnh là gì vậy, dùng VBA có giống như ap lisp thông thường không ạ?
  • 0