có pác nào giúp em sửa đoạn code voi

[unlucky12 0]

đoạn code em dùng để thông kê cốt thép load vào CAD rồi nhưng vẫn chưa hoàn thiện :( :rolleyes:

 

 

 

CODE:

Sub THONGKETHEP()

Dim plineObj As AcadLWPolyline

Dim points(0 To 55) As Double

points(0) = 0: points(1) = 0

points(2) = 14: points(3) = 0

points(4) = 14: points(5) = 16

points(6) = 0: points(7) = 16

points(8) = 0: points(9) = 0

points(10) = 0: points(11) = 15

points(12) = 14: points(13) = 15

points(14) = 14: points(15) = 10

points(16) = 0: points(17) = 10

points(18) = 0: points(19) = 5

points(20) = 14: points(21) = 5

points(22) = 14: points(23) = 0

points(24) = 2: points(25) = 0

points(26) = 2: points(27) = 16

points(28) = 3: points(29) = 16

points(30) = 3: points(31) = 0

points(32) = 6: points(33) = 0

points(34) = 6: points(35) = 16

points(36) = 7: points(37) = 16

points(38) = 7: points(39) = 0

points(40) = 9: points(41) = 0

points(42) = 9: points(43) = 16

points(44) = 10: points(45) = 16

points(46) = 10: points(47) = 0

points(48) = 12: points(49) = 0

points(50) = 12: points(51) = 15.5

points(52) = 10: points(53) = 15.5

points(54) = 14: points(55) = 15.5

Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

ThisDrawing.Application.ZoomAll

plineObj.color = acMagenta

 

 

Dim textObj As AcadText

Dim textString As String

Dim insertionPoint(0 To 2) As Double

Dim height As Double

textString = "TEN-CK"

insertionPoint(0) = 0.4

insertionPoint(1) = 15.5

insertionPoint(2) = 0

height = 0.2

Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)

textObj.Update

 

textString = "SO"

insertionPoint(0) = 2.3

insertionPoint(1) = 15.6

insertionPoint(2) = 0

height = 0.2

Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)

textObj.Update

textString = "HIEU"

insertionPoint(0) = 2.2

insertionPoint(1) = 15.2

insertionPoint(2) = 0

height = 0.2

Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)

textObj.Update

textString = "HINH DANG"

insertionPoint(0) = 3.5

insertionPoint(1) = 15.6

insertionPoint(2) = 0

height = 0.2

Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)

textObj.Update

textString = "KICH THUOC"

insertionPoint(0) = 3.5

insertionPoint(1) = 15.2

insertionPoint(2) = 0

height = 0.2

Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)

textObj.Update

textString = "%%C"

insertionPoint(0) = 6.5

insertionPoint(1) = 15.6

insertionPoint(2) = 0

height = 0.2

Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)

textObj.Update

textString = "(mm)"

insertionPoint(0) = 6.2

insertionPoint(1) = 15.2

insertionPoint(2) = 0

height = 0.2

Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)

textObj.Update

textString = "CHIEU DAI"

insertionPoint(0) = 7.2

insertionPoint(1) = 15.6

insertionPoint(2) = 0

height = 0.2

Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)

textObj.Update

textString = "(mm)"

insertionPoint(0) = 7.7

insertionPoint(1) = 15.2

insertionPoint(2) = 0

height = 0.2

Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)

textObj.Update

textString = "SO"

insertionPoint(0) = 9.3

insertionPoint(1) = 15.6

insertionPoint(2) = 0

height = 0.2

Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)

textObj.Update

textString = "LUONG"

insertionPoint(0) = 9.05

insertionPoint(1) = 15.2

insertionPoint(2) = 0

height = 0.2

Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)

textObj.Update

textString = "TONG"

insertionPoint(0) = 11.6

insertionPoint(1) = 15.65

insertionPoint(2) = 0

height = 0.2

Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)

textObj.Update

textString = "CHIEUDAI(M)"

insertionPoint(0) = 10.05

insertionPoint(1) = 15.105

insertionPoint(2) = 0

height = 0.2

Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)

textObj.Update

textString = "KL(KG)"

insertionPoint(0) = 12.4

insertionPoint(1) = 15.105

insertionPoint(2) = 0

height = 0.2

Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)

textObj.Update

 

 

End Sub

Sub HD1()

Dim plineObj As AcadLWPolyline

Dim points(0 To 5) As Double

points(0) = 3.3: points(1) = 14.3

points(2) = 3.3: points(3) = 14.6

points(4) = 5.8: points(5) = 14.6

Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

ThisDrawing.Application.ZoomAll

plineObj.color = acRed

 

End Sub

Sub HD2()

Dim plineObj As AcadLWPolyline

Dim points(0 To 7) As Double

points(0) = 3.3: points(1) = 13.3

points(2) = 3.3: points(3) = 13.5

points(4) = 5.8: points(5) = 13.5

points(6) = 5.8: points(7) = 13.3

Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

ThisDrawing.Application.ZoomAll

plineObj.color = acRed

 

 

End Sub

Sub HD3()

Dim plineObj As AcadLWPolyline

Dim points(0 To 9) As Double

points(0) = 5.9: points(1) = 12.3

points(2) = 3.3: points(3) = 12.3

points(4) = 3.3: points(5) = 12.6

points(6) = 5.8: points(7) = 12.6

points(8) = 5.8: points(9) = 12.2

Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

ThisDrawing.Application.ZoomAll

plineObj.color = acRed

 

 

End Sub

Sub HD4()

Dim plineObj As AcadLWPolyline

Dim points(0 To 3) As Double

points(0) = 3.3: points(1) = 11.5

points(2) = 5.8: points(3) = 11.5

Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

ThisDrawing.Application.ZoomAll

plineObj.color = acRed

 

 

End Sub

Sub HD5()

Dim plineObj As AcadLWPolyline

Dim points(0 To 9) As Double

points(0) = 5.9: points(1) = 10.3

points(2) = 3.3: points(3) = 10.3

points(4) = 3.3: points(5) = 10.6

points(6) = 5.8: points(7) = 10.6

points(8) = 5.8: points(9) = 10.2

Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

ThisDrawing.Application.ZoomAll

plineObj.color = acRed

 

 

End Sub

 

 

Sub HD6()

Dim plineObj As AcadLWPolyline

Dim points(0 To 3) As Double

points(0) = 3.3: points(1) = 9.5

points(2) = 5.8: points(3) = 9.5

Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

ThisDrawing.Application.ZoomAll

plineObj.color = acRed

Dim numberOfRows As Long

Dim numberOfColumns As Long

Dim numberOfLevels As Long

Dim distanceBwtnRows As Double

Dim distanceBwtnColumns As Double

Dim distanceBwtnLevels As Double

numberOfRows = 2

numberOfColumns = 1

numberOfLevels = 1

distanceBwtnRows = -5

distanceBwtnColumns = 0

distanceBwtnLevels = 1

Dim retObj As Variant

retObj = plineObj.ArrayRectangular(numberOfRows, numberOfColumns, numberOfLevels, distanceBwtnRows, distanceBwtnColumns, distanceBwtnLevels)

MsgBox "Rectangular array completed.", , "Array Rectangular Example"

 

End Sub

Public Sub Rectang(FirstPoint() As Double, EndPoint() As Double)

Dim plineObj As AcadLWPolyline

Dim point(0 To 7) As Double

points(0) = FirstPoint(0): points(1) = FirstPoint(1)

points(2) = EndPoint(0): points(3) = FirstPoint(1)

points(4) = EndPoint(0): points(5) = EndPoint(1)

points(6) = First(0): points(7) = EndPoint(1)

Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

plineObj.colosed = Tru

ThisDrawing.Regen (Tru)

Dim FirstPoint(2) As Double

Dim EndPoint(2) As Double

FirstPoint(0) = 0: FirstPoint(1) = 0: FirstPoint(2) = 0

EndPoint(0) = 20: FirstPoint(1) = 15: FirstPoint(2) = 0

Call Rectang(FirstPoint, EndPoint)

ZoomAll

End Sub

Sub HD7()

Dim plineObj As AcadLWPolyline

Dim points(0 To 9) As Double

points(0) = 5.9: points(1) = 8.3

points(2) = 3.3: points(3) = 8.3

points(4) = 3.3: points(5) = 8.6

points(6) = 5.8: points(7) = 8.6

points(8) = 5.8: points(9) = 8.2

 

Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

ThisDrawing.Application.ZoomAll

plineObj.color = acRed

Dim numberOfRows As Long

Dim numberOfColumns As Long

Dim numberOfLevels As Long

Dim distanceBwtnRows As Double

Dim distanceBwtnColumns As Double

Dim distanceBwtnLevels As Double

numberOfRows = 2

numberOfColumns = 1

numberOfLevels = 1

distanceBwtnRows = -6

distanceBwtnColumns = 0

distanceBwtnLevels = 1

Dim retObj As Variant

retObj = plineObj.ArrayRectangular(numberOfRows, numberOfColumns, numberOfLevels, distanceBwtnRows, distanceBwtnColumns, distanceBwtnLevels)

MsgBox "Rectangular array completed.", , "Array Rectangular Example"

 

 

End Sub

Sub HD8()

Dim plineObj As AcadLWPolyline

Dim points(0 To 9) As Double

points(0) = 4.3: points(1) = 7.1

points(2) = 4.3: points(3) = 7.2

points(4) = 4.4: points(5) = 7.2

points(6) = 4.4: points(7) = 7.1

points(8) = 4.3: points(9) = 7.1

Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

ThisDrawing.Application.ZoomAll

plineObj.color = acRed

 

Dim numberOfRows As Long

Dim numberOfColumns As Long

Dim numberOfLevels As Long

Dim distanceBwtnRows As Double

Dim distanceBwtnColumns As Double

Dim distanceBwtnLevels As Double

numberOfRows = 5

numberOfColumns = 5

numberOfLevels = 2

distanceBwtnRows = 0.1

distanceBwtnColumns = 0.1

distanceBwtnLevels = 0.1

Dim retObj As Variant

retObj = plineObj.ArrayRectangular(numberOfRows, numberOfColumns, numberOfLevels, distanceBwtnRows, distanceBwtnColumns, distanceBwtnLevels)

MsgBox "Rectangular array completed.", , "Array Rectangular Example"

 

 

End Sub

Sub HD9()

Dim plineObj As AcadLWPolyline

Dim points(0 To 15) As Double

points(0) = 4: points(1) = 6.8

points(2) = 4.3: points(3) = 6.2

points(4) = 4.4: points(5) = 6.7

points(6) = 4.5: points(7) = 6.3

points(8) = 4.6: points(9) = 6.6

points(10) = 4.7: points(11) = 6.4

points(12) = 4.8: points(13) = 6.5

points(14) = 4.9: points(15) = 6.5

Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

ThisDrawing.Application.ZoomAll

plineObj.color = acRed

 

 

Dim numberOfRows As Long

Dim numberOfColumns As Long

Dim numberOfLevels As Long

Dim distanceBwtnRows As Double

Dim distanceBwtnColumns As Double

Dim distanceBwtnLevels As Double

numberOfRows = 2

numberOfColumns = 1

numberOfLevels = 1

distanceBwtnRows = -5

distanceBwtnColumns = 0

distanceBwtnLevels = 1

Dim retObj As Variant

retObj = plineObj.ArrayRectangular(numberOfRows, numberOfColumns, numberOfLevels, distanceBwtnRows, distanceBwtnColumns, distanceBwtnLevels)

MsgBox "Rectangular array completed.", , "Array Rectangular Example"

 

End Sub

Sub HD10()

Dim plineObj As AcadLWPolyline

Dim points(0 To 9) As Double

points(0) = 5.5: points(1) = 5.1

points(2) = 3.7: points(3) = 5.1

points(4) = 3.7: points(5) = 5.9

points(6) = 5.5: points(7) = 5.9

points(8) = 5.5: points(9) = 5.1

Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

ThisDrawing.Application.ZoomAll

plineObj.color = acRed

 

End Sub

Sub HD11()

Dim plineObj As AcadLWPolyline

Dim points(0 To 7) As Double

points(0) = 4: points(1) = 0.3

points(2) = 3.7: points(3) = 0.2

points(4) = 4.3: points(5) = 0.2

points(6) = 4.3: points(7) = 0.7

 

Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

ThisDrawing.Application.ZoomAll

plineObj.color = acRed

ZoomAll

Dim point1(0 To 2) As Double

Dim Point2(0 To 2) As Double

point1(0) = 4.5: point1(1) = 0.2: point1(2) = 0

Point2(0) = 4.5: Point2(1) = 0.5: Point2(2) = 0

Dim mirrorObj As AcadLWPolyline

Set mirrorObj = plineObj.Mirror(point1, Point2)

mirrorObj.color = acRed

ZoomAll

 

End Sub

Sub CT()

Dim objArc As AcadArc

Dim varCtrPt As Variant

Dim dblRadius As Double

Dim dblStartAngle As Double

Dim dblEndAngle As Double

varCtrPt = ThisDrawing.Utility.GetPoint(, vbCrLf & "Center point:")

dblStartAngle = ThisDrawing.Utility.GetAngle(varCtrPt, vbCrLf & "Start angle")

dblEndAngle = ThisDrawing.Utility.GetAngle(varCtrPt, vbCrLf & "End angle")

dblRadius = ThisDrawing.Utility.GetReal(vbCrLf & "Radius:")

Set objArc = ThisDrawing.ModelSpace.AddArc(varCtrPt, dblRadius, dblStartAngle, dblEndAngle)

objArc.Update

objArc.color = acRed

 

End Sub

Sub TEXT()

Dim objMtext As AcadMText

Dim varInsPt As Variant

Dim dblWidth As Double

Dim strText As String

varInsPt = ThisDrawing.Utility.GetPoint(, vbCrLf & "Start point:")

dblWidth = ThisDrawing.Utility.GetReal(vbCrLf & "Width:")

strText = ThisDrawing.Utility.GetStringt(True, vbCrLf & "Text:")

Set objMtext = ThisDrawing.ModelSpace.AddText(varInsPt, dblWidth, strText)

objMtext.Update

End Sub

Sub TEXAA()

Dim mtextObj As AcadMText

Dim insertPoint(0 To 2) As Double

Dim Width As Double

Dim textString As String

insertPoint(0) = 4.3: insertPoint(1) = 14.8: insertPoint(2) = 0

Width = 14

textString = "2100"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 3.4: insertPoint(1) = 14.5: insertPoint(2) = 0

Width = 14

textString = "250"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 4.3: insertPoint(1) = 13.8: insertPoint(2) = 0

Width = 14

textString = "1750"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 3.4: insertPoint(1) = 13.4: insertPoint(2) = 0

Width = 14

textString = "750"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 5.3: insertPoint(1) = 13.4: insertPoint(2) = 0

Width = 14

textString = "750"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 4.3: insertPoint(1) = 12.8: insertPoint(2) = 0

Width = 14

textString = "540"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 3.3: insertPoint(1) = 12.5: insertPoint(2) = 0

Width = 14

textString = "340"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 5.5: insertPoint(1) = 12.3: insertPoint(2) = 0

Width = 14

textString = "60"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 4.3: insertPoint(1) = 11.8: insertPoint(2) = 0

Width = 14

textString = "2640"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 4.3: insertPoint(1) = 10.8: insertPoint(2) = 0

Width = 14

textString = "540"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 3.3: insertPoint(1) = 10.5: insertPoint(2) = 0

Width = 14

textString = "340"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 5.5: insertPoint(1) = 10.3: insertPoint(2) = 0

Width = 14

textString = "60"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

insertPoint(0) = 4.3: insertPoint(1) = 9.8: insertPoint(2) = 0

Width = 14

textString = "5000"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 3.3: insertPoint(1) = 8.5: insertPoint(2) = 0

Width = 14

textString = "210"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 4.3: insertPoint(1) = 8.8: insertPoint(2) = 0

Width = 14

textString = "210"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 5.5: insertPoint(1) = 8.3: insertPoint(2) = 0

Width = 14

textString = "60"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 4.3: insertPoint(1) = 5.3: insertPoint(2) = 0

Width = 14

textString = "220"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 5: insertPoint(1) = 5.7: insertPoint(2) = 0

Width = 14

textString = "120"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 4.3: insertPoint(1) = 4.7: insertPoint(2) = 0

Width = 14

textString = "6000"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 3.7: insertPoint(1) = 3.6: insertPoint(2) = 0

Width = 14

textString = "120"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 4.3: insertPoint(1) = 3.3: insertPoint(2) = 0

Width = 14

textString = "220"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 3.3: insertPoint(1) = 2.5: insertPoint(2) = 0

Width = 14

textString = "210"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 4.3: insertPoint(1) = 2.8: insertPoint(2) = 0

Width = 14

textString = "210"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 5.5: insertPoint(1) = 2.3: insertPoint(2) = 0

Width = 14

textString = "60"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 3.7: insertPoint(1) = 1.6: insertPoint(2) = 0

Width = 14

textString = "120"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 4.3: insertPoint(1) = 1.3: insertPoint(2) = 0

Width = 14

textString = "220"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 3.55: insertPoint(1) = 0.45: insertPoint(2) = 0

Width = 14

textString = "50"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

insertPoint(0) = 3.8: insertPoint(1) = 0.2: insertPoint(2) = 0

Width = 14

textString = "150"

Set objMtext = ThisDrawing.ModelSpace.AddMText(insertPoint, Width, textString)

ZoomAll

End Sub

 

Sub DAI()

 

Dim textObj As AcadText

Dim textString As String

Dim insertionPoint(0 To 2) As Double

Dim height As Double

textString = "DAI"

insertionPoint(0) = 1

insertionPoint(1) = 12.5

insertionPoint(2) = 0

height = 0.2

Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)

textObj.Update

Dim basePoint(0 To 2) As Double

Dim rotationAngle As Double

basePoint(0) = 1: basePoint(1) = 12.5: basePoint(2) = 0

rotationAngle = 1.5707963 ' 90 degrees

textObj.Rotate basePoint, rotationAngle

textObj.Update

 

End Sub

Sub COC1()

 

Dim textObj As AcadText

Dim textString As String

Dim insertionPoint(0 To 2) As Double

Dim height As Double

textString = "COC-C1"

insertionPoint(0) = 1

insertionPoint(1) = 7

insertionPoint(2) = 0

height = 0.2

Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)

textObj.Update

Dim basePoint(0 To 2) As Double

Dim rotationAngle As Double

basePoint(0) = 1: basePoint(1) = 7: basePoint(2) = 0

rotationAngle = 1.5707963 ' 90 degrees

textObj.Rotate basePoint, rotationAngle

textObj.Update

End Sub

Sub COC2()

 

Dim textObj As AcadText

Dim textString As String

Dim insertionPoint(0 To 2) As Double

Dim height As Double

textString = "COC-C2"

insertionPoint(0) = 1

insertionPoint(1) = 2

insertionPoint(2) = 0

height = 0.2

Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)

textObj.Update

Dim basePoint(0 To 2) As Double

Dim rotationAngle As Double

basePoint(0) = 1: basePoint(1) = 2: basePoint(2) = 0

rotationAngle = 1.5707963 ' 90 degrees

textObj.Rotate basePoint, rotationAngle

textObj.Update

 

End Sub

 

 

làm ơn sửa giúp em nah mail cua em là taanhvanv30@gmail.com :rolleyes: :rolleyes:

[anhcos 196]

Hiện tại chỉ thấy chương trình in ra khung với hàng tiêu đề thôi.

Còn phần nội dung bên dưới thì chưa thấy gì, cái phần này bạn phải viết tiếp thôi.

 

Góp ý một chút ở chỗ nạp dữ liệu cho mảng, bạn làm như thế này cho gọn:

Đây là phần kẻ khung:

 

Dim plineObj As AcadLWPolyline

Dim points(0 To 55) As Double

points(0) = 0: points(1) = 0 points(2) = 14: points(3) = 0 points(4) = 14: points(5) = 16

points(6) = 0: points(7) = 16 points(8) = 0: points(9) = 0 points(10) = 0: points(11) = 15

points(12) = 14: points(13) = 15 points(14) = 14: points(15) = 10 points(16) = 0: points(17) = 10

points(18) = 0: points(19) = 5 points(20) = 14: points(21) = 5 points(22) = 14: points(23) = 0

points(24) = 2: points(25) = 0 points(26) = 2: points(27) = 16 points(28) = 3: points(29) = 16

points(30) = 3: points(31) = 0 points(32) = 6: points(33) = 0 points(34) = 6: points(35) = 16

points(36) = 7: points(37) = 16 points(38) = 7: points(39) = 0 points(40) = 9: points(41) = 0

points(42) = 9: points(43) = 16 points(44) = 10: points(45) = 16 points(46) = 10: points(47) = 0

points(48) = 12: points(49) = 0 points(50) = 12: points(51) = 15.5 points(52) = 10: points(53) = 15.5

points(54) = 14: points(55) = 15.5

Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

 

VD thay thế:

 

   'biến tạm
  Dim pts As Variant
  pts = Array(0, 0, 14, 0, 14, 16, 0, 16,0,0,0,15) '--> thêm vào cho đủ 56 phần tử

  'mảng chính cần đặt giá trị
  Dim points(0 To 55) As Double
  For i = 0 To UBound(pts) - 1
  points(i) = pts(i)
  Next i

Dim plineObj As AcadLWPolyline
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

 

Với lại ch trình đang dùng tọa độ tuyệt đối, sau này khi cần chèn tại một điểm khác thì hơi mệt vì vậy cần tham số truyền vào cho mỗi hàm:

 

VD Sub Thongke(x as double,y as double) 'x,y là tọa độ điểm chèn

 

thì phần tọa độ của các đối tượng sẽ cộng thêm vào x và y tương ứng

 

Vì thế phần xử lý bên trên viết lại

 Dim points(0 To 55) As Double
  For i = 0 To UBound(pts) - 1
  if i mod 2 = 0 then'vị trí là chẵn --> là tọa độ x
points(i) = pts(i) + x
else
points(i) = pts(i) + y
end if
Next i

[unlucky12 0]

Hiện tại chỉ thấy chương trình in ra khung với hàng tiêu đề thôi.

Còn phần nội dung bên dưới thì chưa thấy gì, cái phần này bạn phải viết tiếp thôi.

 

Góp ý một chút ở chỗ nạp dữ liệu cho mảng, bạn làm như thế này cho gọn:

Đây là phần kẻ khung:

VD thay thế:

 

   'biến tạm
  Dim pts As Variant
  pts = Array(0, 0, 14, 0, 14, 16, 0, 16,0,0,0,15) '--> thêm vào cho đủ 56 phần tử

  'mảng chính cần đặt giá trị
  Dim points(0 To 55) As Double
  For i = 0 To UBound(pts) - 1
  points(i) = pts(i)
  Next i

Dim plineObj As AcadLWPolyline
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)

 

Với lại ch trình đang dùng tọa độ tuyệt đối, sau này khi cần chèn tại một điểm khác thì hơi mệt vì vậy cần tham số truyền vào cho mỗi hàm:

 

VD Sub Thongke(x as double,y as double) 'x,y là tọa độ điểm chèn

 

thì phần tọa độ của các đối tượng sẽ cộng thêm vào x và y tương ứng

 

Vì thế phần xử lý bên trên viết lại

 Dim points(0 To 55) As Double
  For i = 0 To UBound(pts) - 1
  if i mod 2 = 0 then'vị trí là chẵn --> là tọa độ x
points(i) = pts(i) + x
else
points(i) = pts(i) + y
end if
Next i

thanks anh nha nhưng em vẫn chưa hiểu cách load số liệu vào trong bảng hy vọng anh chỉ giúp em với :(

còn đoạn coda tính toán thống kê em vẫn chưa nghĩ ra :rolleyes:

em nghĩ thống kê đường kính theo mau` mà ko hiểu làm cách nào