Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
2 replies to this topic

#1 unlucky12

unlucky12

    biết zoom

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

Đã gửi 15 December 2009 - 10:57 PM

đ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:
  • 0

#2 anhcos

anhcos

    biết lệnh hatchedit

  • Advance Member
  • PipPipPipPip
  • 260 Bài viết
Điểm đánh giá: 170 (tàm tạm)

Đã gửi 16 December 2009 - 08:42 AM

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

  • 1
Clear sky!

MF Rock collection.

#3 unlucky12

unlucky12

    biết zoom

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

Đã gửi 18 December 2009 - 11:03 PM

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
  • 0