Đến nội dung


Hình ảnh
- - - - -

lệnh đối xứng của VBA


  • Please log in to reply
5 replies to this topic

#1 poseidon_hh

poseidon_hh

    biết pan

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

Đã gửi 01 April 2012 - 10:29 AM

em có viết một lệnh sau về đối xứng... vba báo nỗi ở dòng Set mirrorObj = plineObj.Mirror(point1, point2)
-các anh chị nào sửa nỗi dùm e với...
thank trước :blush: :blush: :blush: :blush: :blush: :blush:



private Sub CommandButton3_Click()
Dim lineobj As AcadLine
Dim startpoint(0 To 2) As Double
Dim endpoint(0 To 2) As Double
Dim objent As AcadArc
Dim center(0 To 2) As Double
Dim startangle As Double
Dim endangle As Double
startpoint(0) = 2: startpoint(1) = 1: startpoint(2) = 0
endpoint(0) = 4: endpoint(1) = 1: endpoint(2) = 0
Set lineobj = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)
startpoint(0) = 5: startpoint(1) = 2: startpoint(2) = 0
endpoint(0) = 5: endpoint(1) = 3: endpoint(2) = 0
Set lineobj = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)
startpoint(0) = 4: startpoint(1) = 4: startpoint(2) = 0
endpoint(0) = 2: endpoint(1) = 4: endpoint(2) = 0
Set lineobj = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)
startpoint(0) = 1: startpoint(1) = 3: startpoint(2) = 0
endpoint(0) = 1: endpoint(1) = 2: endpoint(2) = 0
Set lineobj = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)
center(0) = 2: center(1) = 2: center(2) = 0
startangle = 180 * 3.141592654 / 180
endangle = 270 * 3.141592654 / 180
dblRadius = 1
Set objent = ThisDrawing.ModelSpace.AddArc(center, dblRadius, startangle, endangle)
center(0) = 2: center(1) = 3: center(2) = 0
startangle = 90 * 3.141592654 / 180
endangle = 180 * 3.141592654 / 180
dblRadius = 1
Set objent = ThisDrawing.ModelSpace.AddArc(center, dblRadius, startangle, endangle)
center(0) = 4: center(1) = 3: center(2) = 0
startangle = 0 * 3.141592654 / 180
endangle = 90 * 3.141592654 / 180
dblRadius = 1
Set objent = ThisDrawing.ModelSpace.AddArc(center, dblRadius, startangle, endangle)
center(0) = 4: center(1) = 2: center(2) = 0
startangle = 270 * 3.141592654 / 180
endangle = 360 * 3.141592654 / 180
dblRadius = 1
Set objent = ThisDrawing.ModelSpace.AddArc(center, dblRadius, startangle, endangle)


' Xác d?nh tr?c d?i x?ng
Dim point1(0 To 2) As Double
Dim point2(0 To 2) As Double
point1(0) = 6: point1(1) = 1: point1(2) = 0
point2(0) = 6: point2(1) = 4: point2(2) = 0
MsgBox "L?y d?i x?ng du?ng da tuy?n.", , "VD Mirror"
' Th?c hi?n l?y d?i x?ng du?ng da tuy?n
Dim mirrorObj As AcadLWPolyline
[color=#00ff00] Set mirrorObj = plineObj.Mirror(point1, point2)[/color]
mirrorObj.color = acRed
ZoomAll
MsgBox "Mirror completed.", , " VD Mirror"
End Sub

  • 0

#2 Nguyen_Van_Nghia

Nguyen_Van_Nghia

    biết pan

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

Đã gửi 03 April 2012 - 11:08 AM

plineObjd phải là đối tượng gốc (đã tồn tại trên bản vẽ hay được bạn tạo ra trước dòng lện
mirror. Hãy đọc lại ví dụ này để hiểu hơn
Sub Example_Mirror()<pre class="Code"> ' This example creates a lightweight polyline ' and then mirrors that polyline. ' Create the polyline Dim plineObj As AcadLWPolyline Dim points(0 To 11) As Double points(0) = 1: points(1) = 1 points(2) = 1: points(3) = 2 points(4) = 2: points(5) = 2 points(6) = 3: points(7) = 2 points(8) = 4: points(9) = 4 points(10) = 4: points(11) = 1 Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points) plineObj.Closed = True ZoomAll ' Define the mirror axis Dim point1(0 To 2) As Double Dim point2(0 To 2) As Double point1(0) = 0: point1(1) = 4.25: point1(2) = 0 point2(0) = 4: point2(1) = 4.25: point2(2) = 0 MsgBox "Mirror the polyline.", , "Mirror Example" ' Mirror the polyline Dim mirrorObj As AcadLWPolyline Set mirrorObj = plineObj.Mirror(point1, point2) ZoomAll MsgBox "Mirror completed.", , "Mirror Example" End Sub</pre>
  • 1

#3 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 03 April 2012 - 11:35 AM

Bạn này thật lạ.Post nhiều nơi quá mà không để ý đang làm gì.
Đã có ở đây: http://www.cadviet.c...l=&fromsearch=1
Chắc bạn đang học về VBA để thi cử nên copy Code trong sách mà copy thiếu luôn cả mã chuẩn của đoạn hướng dẫn Mirror.:D
  • 0

#4 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 03 April 2012 - 11:50 AM


Sub CommandButton3_Click()
Dim lineobj As AcadLine
Dim startpoint(0 To 2) As Double
Dim endpoint(0 To 2) As Double
Dim objent As AcadArc
Dim center(0 To 2) As Double
Dim startangle As Double
Dim endangle As Double
Dim point1(0 To 2) As Double
Dim point2(0 To 2) As Double
point1(0) = 6: point1(1) = 1: point1(2) = 0
point2(0) = 6: point2(1) = 4: point2(2) = 0
startpoint(0) = 2: startpoint(1) = 1: startpoint(2) = 0
endpoint(0) = 4: endpoint(1) = 1: endpoint(2) = 0
Set lineobj = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)
Call DX(lineobj, point1, point2)
startpoint(0) = 5: startpoint(1) = 2: startpoint(2) = 0
endpoint(0) = 5: endpoint(1) = 3: endpoint(2) = 0
Set lineobj = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)
Call DX(lineobj, point1, point2)
startpoint(0) = 4: startpoint(1) = 4: startpoint(2) = 0
endpoint(0) = 2: endpoint(1) = 4: endpoint(2) = 0
Set lineobj = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)
Call DX(lineobj, point1, point2)
startpoint(0) = 1: startpoint(1) = 3: startpoint(2) = 0
endpoint(0) = 1: endpoint(1) = 2: endpoint(2) = 0
Set lineobj = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)
Call DX(lineobj, point1, point2)
center(0) = 2: center(1) = 2: center(2) = 0
startangle = 180 * 3.141592654 / 180
endangle = 270 * 3.141592654 / 180
dblRadius = 1
Set objent = ThisDrawing.ModelSpace.AddArc(center, dblRadius, startangle, endangle)
Call DX(objent, point1, point2)
center(0) = 2: center(1) = 3: center(2) = 0
startangle = 90 * 3.141592654 / 180
endangle = 180 * 3.141592654 / 180
dblRadius = 1
Set objent = ThisDrawing.ModelSpace.AddArc(center, dblRadius, startangle, endangle)
Call DX(objent, point1, point2)
center(0) = 4: center(1) = 3: center(2) = 0
startangle = 0 * 3.141592654 / 180
endangle = 90 * 3.141592654 / 180
dblRadius = 1
Set objent = ThisDrawing.ModelSpace.AddArc(center, dblRadius, startangle, endangle)
Call DX(objent, point1, point2)
center(0) = 4: center(1) = 2: center(2) = 0
startangle = 270 * 3.141592654 / 180
endangle = 360 * 3.141592654 / 180
dblRadius = 1
Set objent = ThisDrawing.ModelSpace.AddArc(center, dblRadius, startangle, endangle)
Call DX(objent, point1, point2)
ZoomAll
End Sub
Public Sub DX(Duongchuan As Variant, Diemdau() As Double, Diemcuoi() As Double)
Dim Doixung As Variant
Set Doixung = Duongchuan.Mirror(Diemdau, Diemcuoi)
Doixung.color = acRed
End Sub
Của bạn đây. Lấy đối xứng đối tượng và chuyển qua màu đỏ.
Thân!
  • 0

#5 poseidon_hh

poseidon_hh

    biết pan

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

Đã gửi 03 April 2012 - 02:58 PM

em đang làm bài tập lớn anh ạ. tại gấp quá lên mới phải hỏi khắp nơi
dẫu biết là dục tốc là bất đạt, còn không hiểu được nhiều chỗ, lên em vẫn phải nhờ a xem xem code sau đây sai ở chỗ nào:
thân!

Private Sub CommandButton3_Click()
  Dim lineobj As AcadLine
  Dim startpoint(0 To 2) As Double
  Dim endpoint(0 To 2) As Double
  Dim dblRadius As Double
  Dim center(0 To 2) As Double
  Dim startangle As Double
  Dim endangle As Double
  Dim hatchObj As AcadHatch
   Dim patternName As String
   Dim PatternType As Long
   Dim bAssociativity As Boolean
   patternName = "ANSI31"
   PatternType = 0
   bAssociativity = True
   Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)
Dim outerloop(0 To 7) As AcadEntity

startpoint(0) = 2: startpoint(1) = 1: startpoint(2) = 0
endpoint(0) = 4: endpoint(1) = 1: endpoint(2) = 0
Set outerloop(0) = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)


startpoint(0) = 5: startpoint(1) = 2: startpoint(2) = 0
endpoint(0) = 5: endpoint(1) = 3: endpoint(2) = 0
Set outerloop(1) = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)

startpoint(0) = 4: startpoint(1) = 4: startpoint(2) = 0
endpoint(0) = 2: endpoint(1) = 4: endpoint(2) = 0
Set outerloop(2) = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)

startpoint(0) = 1: startpoint(1) = 3: startpoint(2) = 0
endpoint(0) = 1: endpoint(1) = 2: endpoint(2) = 0
Set outerloop(3) = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)

center(0) = 2: center(1) = 2: center(2) = 0
startangle = 180 * 3.141592654 / 180
endangle = 270 * 3.141592654 / 180
dblRadius = 1
  Set outerloop(4) = ThisDrawing.ModelSpace.AcadArc(center, startangle, endangle, dblRadius)
  


center(0) = 2: center(1) = 2: center(2) = 0
startangle = 180 * 3.141592654 / 180
endangle = 270 * 3.141592654 / 180
dblRadius = 1
  Set outerloop(5) = ThisDrawing.ModelSpace.AcadArc(center, startangle, endangle, dblRadius)
  

center(0) = 4: center(1) = 3: center(2) = 0
startangle = 0 * 3.141592654 / 180
endangle = 90 * 3.141592654 / 180
dblRadius = 1
  Set outerloop(6) = ThisDrawing.ModelSpace.AcadArc(center, dblRadius, endangle, startangle)

center(0) = 4: center(1) = 2: center(2) = 0
startangle = 270 * 3.141592654 / 180
endangle = 360 * 3.141592654 / 180
dblRadius = 1
  Set outerloop(7) = ThisDrawing.ModelSpace.AcadArc(center, dblRadius, endangle, startangle)

   hatchObj.AppendOuterLoop (outerloop)
   hatchObj.Evaluate
   ThisDrawing.Regen True

End Sub
  • 0

#6 poseidon_hh

poseidon_hh

    biết pan

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

Đã gửi 03 April 2012 - 03:00 PM

em tham khảo và sửa từ bài này
không hiểu bài này chạy được mà bài của em lại không




Private Sub CommandButton5_Click()

Dim startpoint(0 To 2) As Double
Dim endpoint(0 To 2) As Double
Dim hatchObj As AcadHatch
Dim patternName As String
Dim PatternType As Long
Dim bAssociativity As Boolean
patternName = "ANSI31"
PatternType = 0
bAssociativity = True
Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)
Dim outerloop(0 To 2) As AcadEntity

startpoint(0) = 0: startpoint(1) = 0: startpoint(2) = 0
endpoint(0) = 10: endpoint(1) = 0: endpoint(2) = 0
Set outerloop(0) = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)


startpoint(0) = 0: startpoint(1) = 0: startpoint(2) = 0
endpoint(0) = 0: endpoint(1) = 10: endpoint(2) = 0
Set outerloop(1) = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)

startpoint(0) = 10: startpoint(1) = 0: startpoint(2) = 0
endpoint(0) = 0: endpoint(1) = 10: endpoint(2) = 0
Set outerloop(2) = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)
hatchObj.AppendOuterLoop (outerloop)
hatchObj.Evaluate

Dim hatchObj2 As AcadHatch
Dim patternName2 As String
Dim PatternType2 As Long
Dim bAssociativity2 As Boolean
patternName2 = "ANSI31"
PatternType2 = 0
bAssociativity2 = True
Set hatchObj2 = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)
Dim outerloop2(0 To 2) As AcadEntity
startpoint(0) = -1: startpoint(1) = 0: startpoint(2) = 0
endpoint(0) = -10: endpoint(1) = 0: endpoint(2) = 0
Set outerloop2(0) = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)

startpoint(0) = -1: startpoint(1) = 0: startpoint(2) = 0
endpoint(0) = -10: endpoint(1) = 10: endpoint(2) = 0
Set outerloop2(1) = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)

startpoint(0) = -10: startpoint(1) = 0: startpoint(2) = 0
endpoint(0) = -10: endpoint(1) = 10: endpoint(2) = 0
Set outerloop2(2) = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint)
hatchObj2.AppendOuterLoop (outerloop2)
hatchObj2.Evaluate
ThisDrawing.Regen True

End Sub
  • 0