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

[poseidon_hh 0]

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

[Nguyen_Van_Nghia 1]

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>

[NguyenNgocSon 43]

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.com/forum/index.php?showtopic=62675&hl=&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

[NguyenNgocSon 43]

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!

[poseidon_hh 0]

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

[poseidon_hh 0]

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