Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
poseidon_hh

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

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

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

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

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>

  • 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

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

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

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!

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

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

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

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

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  

×