Imports System.IO
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.Colors
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Runtime
Public Class ModalDialo
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = HostApplicationServices.WorkingDatabase
Public Sub DrawHexagon()
'三点成弧 次序必须是 起点 中间，最后点
Dim startPoint As Point3d = New Point3d(100, 100, 0)
Dim endPoint As Point3d = New Point3d(200, 200, 0)
Dim pointOnArc As Point3d = New Point3d(150, 100, 0)
db.AddarcTomodelspace(startPoint, pointOnArc, endPoint)
'三点成弧 次序必须是 起点 中间，最后点
Dim center = New Point3d(125, 175, 0)
startPoint = New Point3d(100, 100, 0)
Dim point = New Point3d(200, 400, 0)
Dim objid1, objid2 As ObjectId
objid1 = AddEntilyTool.AddarcTomodelspace(db, startPoint, pointOnArc, 135)
objid2 = AddEntilyTool.AddarcTomodelspace_任意点(db, center, startPoint, point)
'Dim arc1 As Arc = objid1.GetObject(OpenMode.ForRead)
'Dim arc2 As Arc = objid1.GetObject(OpenMode.ForRead)
'arc1.ForeachClassProperties(arc2)
doc.SendStringToExecute("_.ZOOM _E ", True, False, False)
End Sub
'画弧形
Public Sub ArcMethod()
Dim arc1 As Arc = New Arc()
arc1.Center = New Point3d(200, 200, 0)
arc1.StartAngle = -Math.PI / 4
arc1.Radius = 66
arc1.EndAngle = Math.PI / 4
Dim degree As Double = 45
Dim arc2 As Arc = New Arc(New Point3d(50, 50, 0), 20, degree.DegreeToAngle, Math.PI / 2)
Dim arc3 As Arc = New Arc(New Point3d(100, 100, 0), New Vector3d(0, 0, 1), 20, Math.PI / 4, Math.PI / 2) 'normal 法向量 0 0 1,平行于x y
Dim fn As String = "三个弧的值"
fn.ForeachClassProperties(arc1, arc2, arc3)
db.AddEntityToModelspace(arc1, arc2, arc3)
doc.SendStringToExecute("_.ZOOM _E ", True, False, False)
End Sub
Public Sub CircleDemo()
Dim c1 As New Circle()
c1.Center = Point(50, 50)
c1.Radius = 50
Dim c2 As Circle = New Circle(Point(100, 100), Normal, 50)
db.AddEntityToModelspace(c1, c2)
'圆心 半经
db.AddCircleModelspace(Point(100, 100), 100)
'两点
db.AddCircleModelspace(Point(200, 100), Point(300, 100))
Dim id As New ObjectId
'三点
db.AddCircleToModelspace(Point(400, 10), Point(300, 100), Point(600, 70))
doc.SendStringToExecute("_.ZOOM _E ", True, False, False)
End Sub
Public Sub PolyLineDemo()
'Dim pl As Polyline = New Polyline()
'Dim p As Point2d = New Point2d(100, 100)
'Dim p2 As Point2d = New Point2d(200, 100)
'Dim p3 As Point2d = New Point2d(600, 200)
'Dim p4 As Point2d = New Point2d(600, 100)
'Dim p5 As Point2d = New Point2d(600, 0)
'Dim p6 As Point2d = New Point2d(400, 50)
'Dim p7 As Point2d = New Point2d(200, 200)
'pl.AddVertexAt(0, p, 1, 0, 0)
'pl.AddVertexAt(1, p2, 12, 0, 0)
'pl.AddVertexAt(2, p3, 43, 0, 0)
'pl.AddVertexAt(3, p4, 74, 0, 0)
'pl.AddVertexAt(4, p5, 95, 0, 0)
'pl.AddVertexAt(5, p6, 116, 0, 0)
'pl.AddVertexAt(6, p7, 369, 0, 0)
'Dim pl As Polyline = New Polyline()
'Dim p As Point2d = New Point2d(100, 100)
'Dim p2 As Point2d = New Point2d(500, 100)
'Dim p3 As Point2d = New Point2d(500, 200)
'Dim p4 As Point2d = New Point2d(100, 200)
'pl.AddVertexAt(0, p, 0, 0, 0)
'pl.AddVertexAt(1, p2, 1, 0, 0)
'pl.AddVertexAt(2, p3, 0, 0, 0)
'pl.AddVertexAt(3, p4, 1, 0, 0)
'pl.Closed = True
'pl.ConstantWidth = 0
'Dim fn = "多段线"
'fn.ForeachClassProperties(pl)
'db.AddEntityToModelspace(pl)
'多段线实现的正多边形
db.AddPolygonToModelspace(New Point2d(100, 100), 50, 3, 90)
db.AddPolygonToModelspace(New Point2d(200, 100), 50, 4, 45)
db.AddPolygonToModelspace(New Point2d(300, 100), 50, 5, 90)
db.AddPolygonToModelspace(New Point2d(400, 100), 50, 6, 45)
db.AddPolygonToModelspace(New Point2d(600, 100), 50, 7, 90)
db.AddPolygonToModelspace(New Point2d(700, 100), 50, 8, 45)
db.AddPolygonToModelspace(New Point2d(800, 100), 50, 9, 90)
db.AddPolygonToModelspace(New Point2d(900, 100), 50, 10, 45)
db.AddPolygonToModelspace(New Point2d(1000, 100), 50, 11, 90)
db.AddPolygonToModelspace(New Point2d(1100, 100), 50, 12, 45)
'db.AddpolyLineToModelspace(New Point2d(10, 10), New Point2d(50, 19), New Point2d(100, 12))
'db.AddpolyLineToModelspace(False, 0, New Point2d(16, 16), New Point2d(56, 16), New Point2d(106, 16))
'db.AddpolyLineToModelspace(True, 0, New Point2d(10, 10), New Point2d(50, 10), New Point2d(100, 80))
'doc.SendStringToExecute("_.ZOOM _E ", True, False, False)
End Sub
Public Sub Rect()
db.AddRectToModelspace(New Point2d(0, 0), New Point2d(100, 100))
db.AddRectToModelspace(New Point2d(200, 200), New Point2d(100, 100))
db.AddRectToModelspace(New Point2d(500, 500), New Point2d(100, 100))
doc.SendStringToExecute("_.ZOOM _E ", True, False, False)
End Sub
Public Sub TaiShen(pt As Point3d, x() As Double)
'Dim X(9) As Double
'X(0) = 100
'X(1) = 40
'X(2) = -20
'X(4) = -25
'X(5) = 20
'X(6) = -(X(0) + X(2) * 2 + X(4))
'X(7) = -200
'X(8) = X(2)
'X(9) = -X(1)
'X(3) = -X(7) - X(5)
Dim points(9) As Point3d
Dim lines(9) As Line
Dim i As Integer
points(0) = Point(0, 0)
For i = 1 To 9
If i Mod 2 = 1 Then
points(i) = Point(points(i - 1).X + x(i - 1), points(i - 1).Y)
Else
points(i) = Point(points(i - 1).X, points(i - 1).Y + x(i - 1))
End If
Next
Dim rotateDim(9) As RotatedDimension
For i = 0 To points.Length - 2
lines(i) = New Line(Point(points(i).X + pt.X, points(i).Y + pt.Y), Point(points(i + 1).X + pt.X, points(i + 1).Y + pt.Y))
rotateDim(i) = getRotateDim(Point(points(i).X + pt.X, points(i).Y + pt.Y), Point(points(i + 1).X + pt.X, points(i + 1).Y + pt.Y))
Next
lines(i) = New Line(Point(points(i).X + pt.X, points(i).Y + pt.Y), Point(points(0).X + pt.X, points(0).Y + pt.Y))
rotateDim(i) = getRotateDim(Point(points(i).X + pt.X, points(i).Y + pt.Y), Point(points(0).X + pt.X, points(0).Y + pt.Y))
'lines(i) = New Line(points(i), points(0))
db.AddLayer("line")
db.AddLayer("rotateDim")
db.SetCurrentLayer("line")
db.AddEntityToModelspace(lines(0), lines(1), lines(2), lines(3), lines(4), lines(5), lines(6), lines(7), lines(8), lines(9))
db.SetCurrentLayer("rotateDim")
db.ChangeLayerColor("rotateDim", 6)
db.AddEntityToModelspace(rotateDim)
doc.SendStringToExecute("_.ZOOM _E ", True, False, False)
End Sub
Private Function getRotateDim(p1 As Point3d, p2 As Point3d) As RotatedDimension
Dim dimLinePoint As New Point3d()
Dim rotation As Double = 0
Dim xLine1Point = p1
Dim xLine2Point = p2
If p1.Y = p2.Y Then
dimLinePoint = Point((p1.X + p2.X) / 2, p1.Y + 12)
Else
dimLinePoint = Point(p2.X + 12, (p1.Y + p2.Y) / 2)
rotation = Math.PI * 0.5 '给垂直的线做标注，要旋转90度
End If
Dim rotatedDim As RotatedDimension = New RotatedDimension With {
.DimensionText = "<>cm",
.Oblique = Math.PI * 0.5 / 1,
.XLine1Point = xLine1Point,
.XLine2Point = xLine2Point,
.DimLinePoint = dimLinePoint,
.Rotation = rotation
}
Return rotatedDim
End Function
Public Sub DrawFile()
Dim filename As String = "C:UsersAdministratorDesktop1.txt"
Dim contents() As String = File.ReadAllLines(filename)
Dim list As New List(Of List(Of String))
For i As Integer = 0 To contents.Length - 1
Dim cont = contents(i).Split(vbTab)
Dim subList As New List(Of String)
For j As Integer = 0 To cont.Length - 1
subList.Add(cont(j))
Next
list.Add(subList)
Next
'声明多段线对象
Dim pLine As New Polyline
For i As Integer = 0 To list.Count - 1
Dim x, y As Double
Dim bx As Boolean = Double.TryParse(list(i)(0), x)
Dim by As Boolean = Double.TryParse(list(i)(1), y)
'如果外部文件出错，给用户提示
If by = False Or bx = False Then
Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
ed.WriteMessage("外部文件有错误！绘制图形失败")
Return
End If
pLine.AddVertexAt(i, New Point2d(x * 1000, y * 1000), 0, 0, 0)
Next
pLine.Closed = True
Dim id As ObjectId = db.AddEntityToModelspace(pLine)
'Dim bk As Color
'bk = Color.FromRgb(255, 0, 255) 'Color.FromColor不能用
'db.HatchEnity(id, 4, bk, HatchPatterName.angle, 20, 30) ' 4是色序，bk是背景色，angle是样式,20是填充密度，30是填充角度
db.HatchEnity(id, 4, Color.FromColorIndex(ColorMethod.ByColor, 2), HatchPatterName.arbrstd, 20, 30) ' Color.FromColorIndex(ColorMethod.ByColor, 2) 色序的第2个值
doc.SendStringToExecute("_.ZOOM _E ", True, False, False)
End Sub
Public Sub ellipseDemo()
'Dim e1 As New Ellipse()
'Dim e2 As New Ellipse(Point(100, 100), Normal, Vector3(100, 0), 0.4, 0, 2 * Math.PI) '原点，与z垂直，
'Dim e3 As New Ellipse(Point(100, 100), Normal, Vector3(100, 100), 0.4, 0, 2 * Math.PI) '原点，与z垂直，
'Dim e4 As New Ellipse(Point(100, 100), Normal, Vector3(0, -1000), 0.4, 0, 2 * Math.PI) '原点，与z垂直，
'Dim e5 As New Ellipse(Point(100, 100), Normal, Vector3(-500, 0), 0.4, 0, 2 * Math.PI) '原点，与z垂直，
'Dim fn As String = "椭圆生气的数据"
'fn.ForeachClassProperties(e2)
'db.AddEntityToModelspace(e2, e3, e4, e5)
'db.AddEllipseToModelspace(Point(100, 100), 200, 50, 0)
'db.AddEllipseToModelspace(Point(400, 400), 200, 50, 0, 90, 180)
'db.AddEllipseToModelspace(Point(700, 700), 350, 150, 45)
'db.AddEllipseToModelspace(Point(1000, 1000), 150, 150, 0, 135, 270)
db.AddRectToModelspace(New Point2d(100, 100), New Point2d(200, 400))
db.AddEllipseToModelspace(Point(100, 100), Point(200, 400))
doc.SendStringToExecute("_.ZOOM _E ", True, False, False)
End Sub
'填充指令
Public Sub HatchDemo() '填充子过程
' '添加一个对象并返回对象id
' Dim cId As ObjectId = db.AddCircleModelspace(Point(100, 100), 100)
' '声明一个对象集合
' Dim obIds As New ObjectIdCollection
' '对象id入集合
' obIds.Add(cId)
' Using trans As Transaction = db.TransactionManager.StartTransaction '库 事务处理 开始工作
' '声明图案填充对象
' Dim hatch As New Hatch
' '设置填充比例
' hatch.PatternScale = 5 '比例
' '设置填充类型和图案名
' hatch.SetHatchPattern(HatchPatternType.PreDefined, "ANGLE")
' '加入到图形数据库当中
' Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead) '打开块表
' Dim btr As BlockTableRecord = CType(trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord) '打开块记录
' btr.AppendEntity(hatch) '加Entity实体对象到块表记录中
' trans.AddNewlyCreatedDBObject(hatch, True) '添加新建立的对象hatch ,True代表加进去
' '设置填充角度
' hatch.PatternAngle = Math.PI / 4
' '关联
' hatch.Associative = True
' '设置边界图形和填充方式
' hatch.AppendLoop(HatchLoopTypes.Outermost, obIds)
' '计算填充并显示效果
' hatch.EvaluateHatch(True)
' '提前事务
' trans.Commit()
' End Using '库事务处理结束工作
'Dim c1 As ObjectId = db.AddCircleModelspace(Point(500, 500), 200)
'Dim c2 As ObjectId = db.AddCircleModelspace(Point(500, 500), 100)
'Dim loopTypes As New List(Of HatchLoopTypes)
'loopTypes.Add(HatchLoopTypes.Outermost)
'loopTypes.Add(HatchLoopTypes.Outermost)
'db.HatchEnity(loopTypes, HatchPatterName.arconc, 0.2, 45, c1, c2)
Dim c3 As ObjectId = db.AddCircleModelspace(Point(1500, 1500), 750)
Dim c4 As ObjectId = db.AddCircleModelspace(Point(1500, 1500), 300)
Dim c5 As ObjectId = db.AddCircleModelspace(Point(1500, 1500), 100)
db.HatchEnity(HatchPatterName.arbrstd, 0.2, 45, c3, c4, c5)
End Sub
'填充指令
Public Sub Hatc() '填充子过程
'Dim colorindex1 As Short = 1
'Dim colorindex2 As Short = 2
'Dim objIds As New ObjectIdCollection
'objIds.Add(db.AddCircleModelspace(Point(100, 100), 100))
'Using trans As Transaction = db.TransactionManager.StartTransaction()
' '声明填充对象
' Dim hatch As Hatch = New Hatch()
' '设置渐变填充的类型和渐变填充的图案名称
' hatch.HatchObjectType = HatchObjectType.GradientObject '为渐变类型
' hatch.SetGradient(GradientPatternType.PreDefinedGradient, "Linear")
' '设置填充颜色
' Dim color1 As Color = Color.FromColorIndex(ColorMethod.ByColor, colorindex1)
' Dim color2 As Color = Color.FromColorIndex(ColorMethod.ByColor, colorindex2)
' Dim gColor1 As GradientColor = New GradientColor(color1, 0)
' Dim gColor2 As GradientColor = New GradientColor(color2, 1)
' Dim gradientcolors() As GradientColor = {gColor1, gColor2}
' hatch.SetGradientColors(gradientcolors)
' '将填充对象加入图形数据库
' '打开块表
' Dim bt As BlockTable = CType(trans.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
' '打开块记录
' Dim btr As BlockTableRecord = CType(trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
' '填充对象入记录
' btr.AppendEntity(hatch)
' '对象进事务
' trans.AddNewlyCreatedDBObject(hatch, True)
' '关联
' hatch.Associative = True
' '关联方式 边界
' hatch.AppendLoop(HatchLoopTypes.Outermost, objIds)
' '计算并显示填充
' hatch.EvaluateHatch(True)
' '执行事务
' trans.Commit()
'End Using '退出事务
Dim ID As ObjectId = db.AddCircleModelspace(Point(100, 100), 100)
db.HatchGradient(1, 3, HatchGradientName.Spherical, ID)
Dim c3 As ObjectId = db.AddCircleModelspace(Point(1500, 1500), 750)
Dim c4 As ObjectId = db.AddCircleModelspace(Point(1500, 1500), 300)
Dim c5 As ObjectId = db.AddCircleModelspace(Point(1500, 1500), 100)
db.HatchGradient(1, 3, HatchGradientName.Invcylinder, c3, c4, c5)
End Sub
Public Sub EditDemo()
Dim c1 As Circle = New Circle(Point(100, 100), Normal, 50)
Dim c2 As Circle = New Circle(Point(200, 100), Normal, 50)
Dim id As ObjectId = db.AddEntityToModelspace(c1)
'Using trans As Transaction = db.TransactionManager.StartTransaction()
' Dim bt As BlockTable = CType(trans.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
' Dim btr As BlockTableRecord = CType(trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForRead), BlockTableRecord)
' Dim ent1 As Entity = CType(id.GetObject(OpenMode.ForWrite), Entity)
' ent1.ColorIndex = 6
' trans.Commit()
'End Using
id.EditEntityColor(2)
c2.EditEntityColor(6)
Dim id2 As ObjectId = db.AddEntityToModelspace(c2)
End Sub
Public Sub MoveDemo()
'Dim c1 As Circle = New Circle(Point(100, 100), Normal, 50)
'Dim c2 As Circle = New Circle(Point(100, 100), Normal, 50)
'Dim id As ObjectId = db.AddEntityToModelspace(c1)
'Using trans As Transaction = db.TransactionManager.StartTransaction()
' Dim bt As BlockTable = CType(trans.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
' Dim btr As BlockTableRecord = CType(trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForRead), BlockTableRecord)
' Dim ent1 As Entity = CType(id.GetObject(OpenMode.ForWrite), Entity)
' ent1.ColorIndex = 6
' trans.Commit()
'End Using
'id.EditEntityColor(2)
'c2.EditEntityColor(6)
'Dim id2 As ObjectId = db.AddEntityToModelspace(c2)
'Dim c1 As Circle = New Circle(Point(100, 100), Normal, 50)
'Dim c2 As Circle = New Circle(Point(100, 100), Normal, 50)
'Dim p1 = Point(0, 0)
'Dim p2 = Point(50, 0)
'c2.Center = Point(c2.Center.X + p2.X - p1.X, c2.Center.Y + p2.Y - p1.Y)
'db.AddEntityToModelspace(c1, c2)
'以下内容的思路：
'开始建立三个完全一样的圆，位置也一样
'显示之前移动了c1
'3个全显
'移动c2
Dim c1 As Circle = New Circle(Point(100, 100), Normal, 50)
Dim c2 As Circle = New Circle(Point(100, 100), Normal, 50)
Dim c3 As Circle = New Circle(Point(100, 100), Normal, 50)
c1.MoveEntity(50, 0)
db.AddEntityToModelspace(c1, c2, c3)
c2.MoveEntity(100, 100)
End Sub
Public Sub CopyDemo()
Dim c1 As Circle = New Circle(Point(0, 0), Normal, 25)
c1.MoveEntity(100, 100) '设计好，并没有显示出来
c1.CopyEntity(100, 0)
c1.CopyEntity(200, 200)
'Dim ls(36) As Point3d
''ls(0) = Point(300, 300)
''ls(1) = Point(400, 400)
''ls(2) = Point(500, 500)
''ls(3) = Point(600, 600)
''c1.ObjectId.CopyEntity(ls)
'For I As Integer = 0 To 9
' ls(I) = Point(0 + I * 50, 0)
'Next
'For I As Integer = 10 To 18
' ls(I) = Point(ls(9).X, ls(9).Y + (I - 9) * 50)
'Next
'For I As Integer = 19 To 27
' ls(I) = Point(ls(18).X - (I - 18) * 50, ls(18).Y)
'Next
'For I As Integer = 28 To 36
' ls(I) = Point(ls(27).X, ls(27).Y - (I - 27) * 50)
'Next
'For i As Integer = n * 0 To n - 1
' ls(i) = Point(0 + i * 50, 0)
'Next
'For i As Integer = n * 1 - 0 To (n - 1) * 2
' ls(i) = Point(ls(n - 1).X, ls(n - 1).Y + (i - (n - 1)) * 50)
'Next
'For i As Integer = n * 2 - 1 To (n - 1) * 3
' ls(i) = Point(ls((n - 1) * 2).X - (i - (n - 1) * 2) * 50, ls((n - 1) * 2).Y)
'Next
'For I As Integer = n * 3 - 2 To (n - 1) * 4
' ls(I) = Point(ls((n - 1) * 3).X, ls((n - 1) * 3).Y - (I - (n - 1) * 3) * 50)
'Next
'以下为原始圆未显示之前的利用
Dim n, n1 As Integer
n = 10
For n1 = 0 To 3
Dim ls() As Point3d
ReDim ls((n - 1) * 4)
Dim d As Integer = 0
Dim f As Integer = 1
For k As Integer = 0 To 3
For i As Integer = n * k - d To (n - 1) * (k + 1)
If k Mod 2 = 0 Then
ls(i) = Point(ls((n - 1) * k).X + f * (i - (n - 1) * k) * 50, ls((n - 1) * k).Y)
Else
ls(i) = Point(ls((n - 1) * k).X, ls((n - 1) * k).Y + f * (i - (n - 1) * k) * 50)
End If
Next
d += 1
If k = 1 Then f = -1
Next
c1.CopyEntity(ls)
c1.MoveEntity(600, 600)
Next
c1.MoveEntity(600, 600)
'显示
db.AddEntityToModelspace(c1)
c1.CopyEntity(100, 100)
'db.AddEntityToModelspace(c1)
'For I As Integer = 0 To ls.Length - 1
' ls(I) = Point(1300, 300 + I * 100)
'Next
'c1.ObjectId.CopyEntity(ls)
End Sub
Public Sub RotatDemo()
Dim l As New Line(Point(0, 0), Point(100, 200))
l.RotateEntity(Point(50, 100), 90)
db.AddEntityToModelspace(l)
Dim lid As ObjectId = db.AddEntityToModelspace(New Line(Point(0, 0), Point(1000, 0)))
lid.RotateEntity(Point(1000, 0), 135)
End Sub
Public Sub MirrDemo()
Dim l As Line = New Line(Point(0, 0), Point(0, 100))
db.AddEntityToModelspace(l)
Dim l2 As Object = l.MirrorEntity(Point(200, 0), Point(200, 100), True)
End Sub
Public Sub ScaleDemo()
Dim c1 As Circle = New Circle(Point(100, 100), Normal, 50)
Dim c2 As Circle = New Circle(Point(100, 100), Normal, 50)
Dim c3 As Circle = New Circle(Point(100, 100), Normal, 50)
c1.ScaleEntity(Point(100, 100), 10)
db.AddEntityToModelspace(c1, c2, c3)
c3.ScaleEntity(Point(100, 100), 5)
c3.ObjectId.EraseEntity()
End Sub
Public Sub ArrayDemo()
'Dim line As Line = New Line(Point(-5, 0), Point(5, 0))
'line.ArrayRectEntity(4, 4, 20, 20)
'Dim line1 As Line = New Line(Point(0, -5), Point(0, 5))
'line1.ArrayRectEntity(4, 4, 20, 20)
'Dim circle As Circle = New Circle(Point(0, 0), Normal, 5)
'circle.ArrayRectEntity(4, 4, 20, 20)
'Dim circle1 As Circle = New Circle(Point(0, 0), Normal, 2)
'circle1.ArrayRectEntity(4, 4, 20, 20)
'Dim circle2 As Circle = New Circle(Point(0, 0), Normal, 8)
'circle2.ArrayRectEntity(4, 4, 20, 20)
Dim line As Line = New Line(Point(-5, 0), Point(5, 0))
line.ArrayPolarEntity(16, 360, Point(100, 100))
Dim line1 As Line = New Line(Point(0, -5), Point(0, 5))
line1.ArrayPolarEntity(16, 360, Point(100, 100))
Dim circle As Circle = New Circle(Point(0, 0), Normal, 5)
circle.ArrayPolarEntity(16, 360, Point(100, 100))
Dim circle1 As Circle = New Circle(Point(0, 0), Normal, 2)
circle.ArrayPolarEntity(16, 360, Point(100, 100))
Dim circle2 As Circle = New Circle(Point(0, 0), Normal, 8)
circle.ArrayPolarEntity(16, 360, Point(100, 100))
End Sub
Public Sub FangLine()
Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
'声明一个直线的集合对象
Dim lineList As New List(Of ObjectId)
'声明一个预备对象
Dim pointStart As Point3d = Point(0, 0)
Dim pointPre As Point3d = Point(0, 0)
Dim pointNext As Point3d = Point(0, 0)
Dim ppr As PromptPointResult = ed.GetPoint2(vbCrLf & "指定第一个点")
If (ppr.Status = PromptStatus.Cancel) Then Return
If (ppr.Status = PromptStatus.None) Then pointStart = ppr.Value
If (ppr.Status = PromptStatus.OK) Then
pointStart = ppr.Value
pointPre = pointStart
End If
Dim isC As Boolean = True
Do While isC
If ppr.StringResult = "U" And lineList.Count = -1 Then
Return
End If
If lineList.Count > 2 Then
ppr = ed.GetPoint(vbCrLf & "指定下一个点或[全销毁(I)/闭合(C)/放弃(U)]", pointPre, New String() {"I", "C", "U"})
Else
ppr = ed.GetPoint(vbCrLf & "指定下一个点或[放弃(U)]", pointPre, New String() {"U"})
End If
If (ppr.Status = PromptStatus.Cancel) Then Return
If (ppr.Status = PromptStatus.None) Then Return
If (ppr.Status = PromptStatus.OK) Then
pointNext = ppr.Value
lineList.Add(db.AddLineToModelSpace(pointPre, pointNext))
pointPre = pointNext
End If
If (ppr.Status = PromptStatus.Keyword) Then
Select Case ppr.StringResult
Case "U"
If lineList.Count = 0 Then
pointStart = Point(0, 0)
pointPre = Point(0, 0)
ElseIf lineList.Count > 0 Then
Dim maxindex = lineList.Count - 1
Dim lId As ObjectId = lineList.ElementAt(maxindex)
pointPre = lId.GetEntityStartPoint
lineList.RemoveAt(maxindex)
lId.EraseEntity
End If
Case "C"
lineList.Add(db.AddLineToModelSpace(pointPre, pointStart))
isC = False
Case "I"
For i As Integer = 0 To lineList.Count - 1
Dim maxindex = lineList.Count - 1
Dim lId As ObjectId = lineList.ElementAt(maxindex)
pointPre = lId.GetEntityStartPoint
lineList.RemoveAt(maxindex)
lId.EraseEntity
Next
isC = False
End Select
End If
Loop
'循环结束 要做某事
End Sub
Public Function JiaoDian() As Point3d
Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
'声明一个直线的集合对象
Dim lineList As New List(Of ObjectId)
'声明一个预备对象
Dim ppr As PromptPointResult = ed.GetPoint2(vbCrLf & "指定一个点")
If (ppr.Status = PromptStatus.Cancel) Then Return Point(-1, -1)
If (ppr.Status = PromptStatus.None) Then Return Point(-1, -1)
If (ppr.Status = PromptStatus.OK) Then
Return ppr.Value
End If
End Function
Public Sub ModalDialog()
Dim form As ModalFrom = New ModalFrom
form.ShowDialog() '模态方式显示
End Sub
Public Sub AddText()
Dim db As Database = HostApplicationServices.WorkingDatabase
Using trans As Transaction = db.TransactionManager.StartTransaction()
Dim textFirst As DBText = New DBText With {
.Position = New Point3d(50, 50, 0),
.Height = 5,
.TextString = "面积" & TextSpecialSymbol.AlmostEqual + TextSpecialSymbol.Underline & "2000" + TextSpecialSymbol.Underline & "m" + TextSpecialSymbol.Square,
.HorizontalMode = TextHorizontalMode.TextCenter,
.VerticalMode = TextVerticalMode.TextVerticalMid
}
textFirst.AlignmentPoint = textFirst.Position
Dim textSecond As DBText = New DBText With {
.Height = 5,
.TextString = TextSpecialSymbol.Angle + TextSpecialSymbol.Belta & "=45" + TextSpecialSymbol.Degree,
.HorizontalMode = TextHorizontalMode.TextCenter,
.VerticalMode = TextVerticalMode.TextVerticalMid,
.AlignmentPoint = New Point3d(50, 40, 0)
}
Dim textLast As DBText = New DBText With {
.Height = 5,
.TextString = TextSpecialSymbol.Diameter & "30的直径偏差为" + TextSpecialSymbol.Tolerance & "0.01" + TextSpecialSymbol.Angle,
.HorizontalMode = TextHorizontalMode.TextCenter,
.VerticalMode = TextVerticalMode.TextVerticalMid,
.AlignmentPoint = New Point3d(50, 30, 0)
}
Dim textLast1 As DBText = New DBText With {
.Height = 5,
.TextString = TextSpecialSymbol.Diameter & "30的直径偏差为" + 文本特殊符号.公差符号 + TextSpecialSymbol.Tolerance & "0.01" + TextSpecialSymbol.Angle,
.HorizontalMode = TextHorizontalMode.TextCenter,
.VerticalMode = TextVerticalMode.TextVerticalMid,
.AlignmentPoint = New Point3d(50, 20, 0)
}
db.AddEntityToModelspace(textFirst, textSecond, textLast, textLast1)
trans.Commit()
End Using
End Sub
Public Sub AddStackText()
Dim db As Database = HostApplicationServices.WorkingDatabase
Using trans As Transaction = db.TransactionManager.StartTransaction()
Dim mtext As MText = New MText()
mtext.Location = New Point3d(100, 40, 0)
Dim firstLine As String = StackText(TextSpecialSymbol.Diameter & "20", "H7", "P7", StackType.HorizontalFraction, 0.5)
Dim secondLine As String = StackText(TextSpecialSymbol.Diameter & "20", "H7", "P7", StackType.ItalicFraction, 0.5)
Dim lastLine As String = StackText(TextSpecialSymbol.Diameter & "20", "+0.020", "-0.010", StackType.Tolerance, 0.5)
mtext.Contents = firstLine & MText.ParagraphBreak & secondLine & vbLf & lastLine
mtext.TextHeight = 5
mtext.Width = 0
mtext.Attachment = AttachmentPoint.MiddleCenter
db.AddEntityToModelspace(mtext)
trans.Commit()
End Using
End Sub
Public Sub CaiYang()
'声明一个 Editor 对象 编辑器
Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
'提示用户获取点用 编辑器下的 GetEntity方法，返回一个 PromptEntityResult 类型 用变量perBase接收
Dim perBase As PromptEntityResult = ed.GetEntity(vbCrLf & "请选择基准线：")
'如果接收到的信息状态 Status =PromptStatus.OK 则得到一个Entity对象，其他则没成功得到值 结束子程序
If perBase.Status <> PromptStatus.OK Then Return
'保存对象id
Dim baseEntityId As ObjectId = perBase.ObjectId
Dim perCurve As PromptEntityResult = ed.GetEntity(vbCrLf & "请选择采样线：")
If perCurve.Status <> PromptStatus.OK Then Return
Dim cuvrveEntityId As ObjectId = perCurve.ObjectId
'根据 两图形ID 提供对象
Dim baseEntity As Entity = baseEntityId.GetEntity()
Dim curve As Entity = cuvrveEntityId.GetEntity()
If TypeOf baseEntity Is Line Then
Dim baseLine As Line = CType(baseEntity, Line)
Dim divPoints As List(Of Point3d) = Me.GetBaseLineDivPoints(baseLine, 1000)
Dim divLines As List(Of Line) = Me.GetDivLines(divPoints.ToArray(), baseLine.Angle + Math.PI * 0.5, 100)
divLines = Me.ModifyDivLines(divLines.ToArray(), curve)
Dim dimTexts As List(Of DBText) = Me.GetDivDimTexts(divLines.ToArray(), 5, -15)
Me.AddEntity(db, divLines.ToArray())
Me.AddEntity(db, dimTexts.ToArray())
Else
ed.WriteMessage(vbCrLf & "基准线必须是直线！")
End If
End Sub
Private Function GetDivDimTexts(ByVal lines As Line(), ByVal height As Double, ByVal dist As Double) As List(Of DBText)
Dim texts As List(Of DBText) = New List(Of DBText)()
Dim db As Database = HostApplicationServices.WorkingDatabase
Using trans As Transaction = db.TransactionManager.StartTransaction()
For i As Integer = 0 To lines.Length - 1
Dim text As DBText = New DBText()
If lines(i).Angle >= 0 AndAlso lines(i).Angle <= Math.PI Then
text.TextString = String.Format("{0:N}", lines(i).Length)
text.Rotation = lines(i).Angle
text.HorizontalMode = TextHorizontalMode.TextRight
Else
text.TextString = "-" & String.Format("{0:N}", lines(i).Length)
text.Rotation = lines(i).Angle + Math.PI
text.HorizontalMode = TextHorizontalMode.TextLeft
End If
text.Position = Me.PolarPoint(lines(i).StartPoint, dist, lines(i).Angle)
text.Height = height
text.VerticalMode = TextVerticalMode.TextVerticalMid
text.AlignmentPoint = text.Position
texts.Add(text)
Next
End Using
Return texts
End Function
Private Function ModifyDivLines(ByVal lines As Line(), ByVal ent As Entity) As List(Of Line)
Dim divLines As List(Of Line) = New List(Of Line)()
For i As Integer = 0 To lines.Length - 1
Dim insertPoints As Point3dCollection = New Point3dCollection()
lines(i).IntersectWith(ent, Intersect.ExtendThis, insertPoints, IntPtr.Zero, IntPtr.Zero)
If insertPoints.Count > 0 Then
lines(i).EndPoint = insertPoints(0)
divLines.Add(lines(i))
End If
Next
Return divLines
End Function
Private Function GetDivLines(ByVal points As Point3d(), ByVal angle As Double, ByVal length As Double) As List(Of Line)
Dim lines As List(Of Line) = New List(Of Line)()
For i As Integer = 0 To points.Length - 1
lines.Add(New Line(points(i), Me.PolarPoint(points(i), length, angle)))
Next
Return lines
End Function
Private Function AddEntity(ByVal db As Database, ParamArray ents As Entity()) As List(Of ObjectId)
Dim entIds As List(Of ObjectId) = New List(Of ObjectId)()
Using trans As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = CType(trans.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
Dim btr As BlockTableRecord = CType(trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
For i As Integer = 0 To ents.Length - 1
entIds.Add(btr.AppendEntity(ents(i)))
trans.AddNewlyCreatedDBObject(ents(i), True)
Next
trans.Commit()
End Using
Return entIds
End Function
Private Function GetBaseLineDivPoints(ByVal line As Line, ByVal divnum As Integer) As List(Of Point3d)
Return Me.GetBaseLineDivPoints(line, line.Length / divnum)
End Function
Private Function GetBaseLineDivPoints(ByVal line As Line, ByVal divDistence As Double) As List(Of Point3d)
Dim points As List(Of Point3d) = New List(Of Point3d)()
Dim divNum As Integer = CInt((line.Length / divDistence))
Dim startPoint As Point3d = line.StartPoint
Dim angle As Double = line.Angle
For i As Integer = 0 To divNum + 1 - 1
points.Add(Me.PolarPoint(startPoint, divDistence * i, angle))
Next
If divDistence * divNum <> line.Length Then
points.Add(line.EndPoint)
End If
Return points
End Function
Private Function PolarPoint(ByVal startPoint As Point3d, ByVal dist As Double, ByVal angle As Double) As Point3d
Dim X As Double = startPoint.X + dist * Math.Cos(angle)
Dim Y As Double = startPoint.Y + dist * Math.Sin(angle)
Return New Point3d(X, Y, 0)
End Function
Private Function GetEntity(ByVal db As Database, ByVal entId As ObjectId) As Entity
Dim ent As Entity
Using trans As Transaction = db.TransactionManager.StartTransaction()
ent = CType(entId.GetObject(OpenMode.ForRead), Entity)
End Using
Return ent
End Function
'Entity 下的标注类，也叫注视类:Dimension
'AlignedDimension
'ArcDimension
'DiametricDimension
'LineAngularDimenslon2
'OrdinateDimension
'Point3AngularDimension
'RadialDimension
'RotatedDimension
Public Sub RotatedDimDemo()
Dim rotatedDim As RotatedDimension = New RotatedDimension
rotatedDim.XLine1Point = Point(100, 100)
rotatedDim.XLine2Point = Point(200, 200)
'rotatedDim.DimensionText=
rotatedDim.DimLinePoint = Point(300, 400) '这样是在右侧
rotatedDim.DimLinePoint = Point(300, 150) '这样是在左侧
db.AddEntityToModelspace(rotatedDim)
End Sub
Public Sub DimDemo()
Dim arc As Arc = New Arc
arc.Center = Point(10, 10)
arc.Radius = 50
arc.StartAngle = 0
Dim endDegree As Double = 45
arc.EndAngle = endDegree.DegreeToAngle
db.AddEntityToModelspace(arc)
Dim arcDim As ArcDimension = New ArcDimension(arc.Center, arc.StartPoint, arc.EndPoint,
Point(arc.EndPoint.X + 5, arc.EndPoint.Y), "<>", db.Dimstyle)
db.AddEntityToModelspace(arcDim)
End Sub
Public Sub DimCircle()
Dim circle As Circle = New Circle
circle.Center = Point(10, 10)
circle.Radius = 10
Dim rDim As RadialDimension = New RadialDimension With {
.Center = Point(10, 10),
.ChordPoint = circle.StartPoint,
.LeaderLength = -1
}
Dim dDim As DiametricDimension = New DiametricDimension
dDim.ChordPoint = circle.StartPoint
dDim.FarChordPoint = Point(circle.Center.X - circle.Radius, circle.Center.Y) '法弦点
dDim.LeaderLength = 5
db.AddEntityToModelspace(circle)
db.AddEntityToModelspace(rDim)
db.AddEntityToModelspace(dDim)
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'图层操作
Public Sub LayerDemo()
db.AddLayer("111")
End Sub
Public Sub ran1()
'声明一个 Editor 对象 编辑器
Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
'提示用户获取点用 编辑器下的 GetEntity方法，返回一个 PromptEntityResult 类型 用变量perBase接收
Dim perBase As PromptEntityResult = ed.GetEntity(vbCrLf & "请选择基准字：")
'如果接收到的信息状态 Status =PromptStatus.OK 则得到一个Entity对象，其他则没成功得到值 结束子程序
If perBase.Status <> PromptStatus.OK Then Return
'保存对象id
Dim baseTextid As ObjectId = perBase.ObjectId
db.AddLayer("ran1")
db.SetCurrentLayer("ran1")
Dim i As Integer
Dim j As Integer
Dim baseEntity As Entity
For i = 0 To 22
For j = 0 To 2
If i = 0 And j = 0 Then
'如果这位置则不画
Else
baseEntity = baseTextid.GetEntity()
If TypeOf baseEntity Is DBText Then
Dim baseText As DBText = CType(baseEntity, DBText)
Dim text As DBText = New DBText()
text.TextString = Mid(baseText.TextString, 1, 3) & (4 + i + j * 23)
text.Height = baseText.Height
text.Position = Point(3756 * i + baseText.Position.X, baseText.Position.Y - 4300 * j)
db.AddEntityToModelspace(text)
End If
End If
Next
Next
End Sub
Public Sub ran2()
'声明一个 Editor 对象 编辑器
Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
'提示用户获取点用 编辑器下的 GetEntity方法，返回一个 PromptEntityResult 类型 用变量perBase接收
Dim perBase As PromptEntityResult = ed.GetEntity(vbCrLf & "请选择基准字：")
'如果接收到的信息状态 Status =PromptStatus.OK 则得到一个Entity对象，其他则没成功得到值 结束子程序
If perBase.Status <> PromptStatus.OK Then Return
'保存对象id
Dim baseTextid As ObjectId = perBase.ObjectId
Dim baseEntity As Entity
baseEntity = baseTextid.GetEntity()
'提示用户获取点用 编辑器下的 GetEntity方法，返回一个 PromptEntityResult 类型 用变量perBase接收
perBase = ed.GetEntity(vbCrLf & "请选择要复制的字：")
'如果接收到的信息状态 Status =PromptStatus.OK 则得到一个Entity对象，其他则没成功得到值 结束子程序
If perBase.Status <> PromptStatus.OK Then Return
'保存对象id
Dim copyTextid As ObjectId = perBase.ObjectId
Dim copyEntity As Entity
copyEntity = copyTextid.GetEntity()
db.AddLayer("ZZ")
db.SetCurrentLayer("ZZ")
db.ChangeLayerColor("ZZ", 6)
'BEAM_NUM_HOR
Dim textIdCollection As ObjectIdCollection = GetObjectIdsAtLayer("BEAM_NUM_HOR")
If TypeOf baseEntity Is DBText And TypeOf copyEntity Is DBText Then
Dim baseText As DBText = CType(baseEntity, DBText)
Dim copyText As DBText = CType(copyEntity, DBText)
Dim i As Integer
For i = 0 To textIdCollection.Count - 1
Dim bltext As DBText = CType(textIdCollection(i).GetEntity, DBText)
If bltext.TextString = baseText.TextString Then
Dim text As DBText = New DBText()
text.TextString = copyText.TextString
text.Position = Point(bltext.Position.X - 600, copyText.Position.Y + 411)
text.WidthFactor = copyText.WidthFactor
text.Height = bltext.Height
db.AddEntityToModelspace(text)
End If
Next
End If
'Dim j As Integer
'Dim baseEntity As Entity
'For i = 0 To 22
' For j = 0 To 2
' If i = 0 And j = 0 Then
' '如果这位置则不画
' Else
' baseEntity = baseTextid.GetEntity()
' If TypeOf baseEntity Is DBText Then
' Dim baseText As DBText = CType(baseEntity, DBText)
' Dim text As DBText = New DBText()
' text.TextString = baseText.TextString
' text.Height = baseText.Height
' text.Position = Point(3756 * i + baseText.Position.X, baseText.Position.Y - 4300 * j)
' db.AddEntityToModelspace(text)
' End If
' End If
' Next
'Next
End Sub
End Class
Imports Autodesk.AutoCAD.Colors
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports System.Reflection
Imports System.Runtime.CompilerServices
Partial Module AddEntilyTool
Public Function GetEntityStartPoint(entId As ObjectId) As Point3d
Using trans As Transaction = entId.Database.TransactionManager.StartTransaction '库 事务处理 开始工作
Dim ent As Entity = CType(entId.GetObject(OpenMode.ForRead), Entity)
Dim p As New Point3d(0, 0, 0)
For Each pinfo As PropertyInfo In ent.[GetType]().GetProperties()
If pinfo.Name = "StartPoint" Then
Dim obj As Object = pinfo.GetValue(ent, Nothing)
p = CType(obj, Point3d)
Return p
End If
Next
Return p
End Using
End Function
#Region "将单个对象加入图形文件中"
'''
''' 将图形对象添加到图形文件中
'''
''' 图形数据库
''' 图形对象
''' 图形的objectID
Public Function AddEntityToModelspace(ByVal db As Database, ent As Entity) As ObjectId
Dim entId As ObjectId = ObjectId.Null
Using trans As Transaction = db.TransactionManager.StartTransaction '库 事务处理 开始工作
Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead) '打开块表
Dim btr As BlockTableRecord = trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite) '打开块记录
entId = btr.AppendEntity(ent) '加Entity对象到块表记录中
trans.AddNewlyCreatedDBObject(ent, True) '更新
trans.Commit()
End Using
Return entId
End Function
#End Region
#Region "将多个对象加入图形文件中"
'''
''' 将图形对象添加到图形文件中
'''
''' 图形数据库
''' 图形对象,可变参数
''' 图形的objectID,数组返回
Public Function AddEntityToModelspace(ByVal db As Database, ParamArray ents As Entity()) As ObjectId()
Dim entID() As ObjectId
ReDim entID(ents.Count - 1)
Using trans As Transaction = db.TransactionManager.StartTransaction '开启事务处理
Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead) '打开块表
Dim btr As BlockTableRecord = trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite) '打开块记录
Dim i As Integer = 0
For i = 0 To ents.Count - 1
entID(i) = btr.AppendEntity(ents(i)) '加Entity对象到块表记录中
trans.AddNewlyCreatedDBObject(ents(i), True) '更新
Next
trans.Commit()
End Using
Return entID
End Function
#End Region
#Region "绘制直线 点点线"
'''
''' 绘制直线
'''
''' 图形数据库
''' 起点坐标
''' 终点坐标
''' ObjectId
Public Function AddLineToModelSpace(ByVal db As Database, startPoint As Point3d, endPoint As Point3d) As ObjectId
Return db.AddEntityToModelspace(New Line(startPoint, endPoint))
End Function
#End Region
#Region "绘制直线 点 长度 角度（内有转成弧度）"
'只知道起点，长度和角度的情况
'''
''' 绘制直线
'''
''' 图形数据库
''' 起点坐标
''' 直线长度
''' 与x轴正方向的角度
''' ObjectId
Public Function AddLineToModelSpace(ByVal db As Database, startPoint As Point3d, length As Double, degree As Double) As ObjectId
Dim x As Double = startPoint.X + length * Math.Cos(degree.DegreeToAngle)
Dim y As Double = startPoint.Y + length * Math.Sin(degree.DegreeToAngle)
Dim endPoint As Point3d = New Point3d(x, y, 0)
Return db.AddEntityToModelspace(New Line(startPoint, endPoint))
End Function
#End Region
#Region "绘制弧线 点 半径 开始角度 结束角度（内有转成弧度）"
'''
''' 绘制弧线
'''
''' 图形数据库
''' 圆弧所在圆的圆心
''' 圆弧的半径
''' 起始角度
''' 终止角度
''' ObjectId
Public Function AddarcToModelSpace(ByVal db As Database, center As Point3d, radius As Double, starDegree As Double, endDegree As Double) As ObjectId
Dim arc As Arc = New Arc(center:=center, radius:=radius, startAngle:=starDegree.DegreeToAngle, endAngle:=endDegree.DegreeToAngle)
Return db.AddEntityToModelspace(arc)
End Function
#End Region
#Region "绘制弧线 起点，中间点 终点"
'''
''' 绘制弧线 起点，中间点 终点
'''
''' 图形数据库
''' 起点
''' 中间点
''' 终点
''' ObjectId
Public Function AddarcTomodelspace(db As Database, startPoint As Point3d, pointOnArc As Point3d, endPoint As Point3d) As ObjectId
If startPoint.IsOnOneLine(pointOnArc, endPoint) Then
Return ObjectId.Null
End If
'通过CircularArc3d推算出 圆心是多少 ，半径是多少
Dim cArc As CircularArc3d = New CircularArc3d(startPoint, pointOnArc, endPoint) '计算用的，并不是画图 可推出 圆心和半径等参数
Dim radius As Double = cArc.Radius
Dim center As Point3d = cArc.Center
Dim arc As Arc = New Arc(cArc.Center, cArc.Radius, cArc.Center.GetAngleToXaxis(startPoint), cArc.Center.GetAngleToXaxis(endPoint))
Return db.AddEntityToModelspace(arc)
End Function
#End Region
#Region "通过圆心 起点 夹角绘制圆弧"
'''
''' 通过圆心 起点 夹角绘制圆弧
'''
''' 图形数据库
''' 圆心
''' 起点
''' 夹角,角度
''' ObjectId
Public Function AddarcTomodelspace(db As Database, center As Point3d, startPoint As Point3d, degree As Double) As ObjectId
'获取半径 原点与端点之间的距离
Dim radius As Double = GetDistanceBetweenTwoPoint(center, startPoint)
'获取起点角度
Dim startAngle As Double = center.GetAngleToXaxis(startPoint)
'创建圆弧
Dim arc As Arc = New Arc(center:=center, radius:=radius, startAngle:=startAngle, endAngle:=startAngle + degree.DegreeToAngle)
Return db.AddEntityToModelspace(arc)
End Function
#End Region
#Region "通过圆心 起点，任意不在弧上的点绘制圆弧"
'''
''' 通过圆心 起点，任意不在弧上的点绘制圆弧
'''
''' 图形数据库
''' 圆心
''' 起点
''' 不在弧上的任意点
'''
Public Function AddarcTomodelspace_任意点(db As Database, center As Point3d, startPoint As Point3d, point As Point3d) As ObjectId
Dim sAngle As Double = center.GetAngleToXaxis(startPoint)
Dim eAngle As Double = center.GetAngleToXaxis(point)
Dim radius As Double = center.GetDistanceBetweenTwoPoint(startPoint)
'创建圆弧
Dim arc As Arc = New Arc(center:=center, radius:=radius, startAngle:=sAngle, endAngle:=eAngle)
Return db.AddEntityToModelspace(arc)
End Function
#End Region
#Region "绘制圆 通过圆心，半径"
'''
''' 绘制圆
'''
''' 图形数据库
''' 圆心
''' 半径
''' ObjectId
Public Function AddCircleModelspace(db As Database, center As Point3d, radius As Double) As ObjectId
Dim circle As Circle = New Circle(center:=center, Normal, radius:=radius)
Return db.AddEntityToModelspace(circle)
End Function
#End Region
#Region "绘制圆 点 点 画圆"
'''
''' 绘制圆 点 点 画圆
'''
''' 图形数据库
''' 第一个点
''' 第二个点
''' ObjectId
Public Function AddCircleModelspace(db As Database, point1 As Point3d, point2 As Point3d) As ObjectId
'获取中心点
Dim center = point1.GetCenterPointBetweenTwoPoint(point2)
'获取半径
Dim radius = point1.GetDistanceBetweenTwoPoint(center)
Dim circle As Circle = New Circle(center:=center, Normal, radius:=radius)
Return db.AddEntityToModelspace(circle)
End Function
#End Region
#Region "绘制圆 点 点 点"
'''
''' 绘制圆 点 点 点
'''
''' 图形数据库
''' 第一个点
''' 第二个点
''' 第三个点
''' ObjectId
Public Function AddCircleToModelspace(db As Database, point1 As Point3d, point2 As Point3d, point3 As Point3d) As ObjectId
'判断三点是否在同一条直线上
If point1.IsOnOneLine(point2, point3) Then
Return ObjectId.Null
End If
'声明几何类的CircularArc3d对象
Dim cArc As CircularArc3d = New CircularArc3d(point1, point2, point3)
Dim circle As Circle = New Circle(center:=cArc.Center, Normal, radius:=cArc.Radius)
'Dim fn As String = "一个CircularArc3d几何圆的值"
'fn.ForeachClassProperties(cArc)
Return db.AddEntityToModelspace(circle)
End Function
#End Region
Public Function AddpolyLineToModelspace(db As Database, ParamArray vertices As Point2d()) As ObjectId
If vertices.Length < 2 Then
Return ObjectId.Null
End If
'声明一个多段线对象
Dim pLine As Polyline = New Polyline()
'添加多段线的顶点
For i As Integer = 0 To vertices.Length - 1
pLine.AddVertexAt(i, vertices(i), 0, 0, 0)
Next
Return db.AddEntityToModelspace(pLine)
End Function
'''
''' 绘制折线多段线
'''
''' 图形数据库
''' 是否闭合
''' 线宽
''' 多段线的定点,可变参数
''' ObjectId
Public Function AddpolyLineToModelspace(db As Database, closed As Boolean, constantWidth As Double, ParamArray vertices As Point2d()) As ObjectId
If vertices.Length < 2 Then
Return ObjectId.Null
End If
'声明一个多段线对象
Dim pLine As Polyline = New Polyline()
'添加多段线的顶点
For i As Integer = 0 To vertices.Length - 1
pLine.AddVertexAt(i, vertices(i), 0, 0, 0)
Next
pLine.Closed = closed
pLine.ConstantWidth = constantWidth
Return db.AddEntityToModelspace(pLine)
End Function
'''
''' 绘制矩形
'''
''' 图形数据库
''' 第一个点
''' 对角点
''' ObjectId
Public Function AddRectToModelspace(db As Database, point1 As Point2d, point2 As Point2d) As ObjectId
'声明多段线变量
Dim pLine As Polyline = New Polyline
'计算矩形的四个顶点坐标
Dim p1 As Point2d = New Point2d(Math.Min(point1.X, point2.X), Math.Min(point1.Y, point2.Y))
Dim p2 As Point2d = New Point2d(Math.Max(point1.X, point2.X), Math.Min(point1.Y, point2.Y))
Dim p3 As Point2d = New Point2d(Math.Max(point1.X, point2.X), Math.Max(point1.Y, point2.Y))
Dim p4 As Point2d = New Point2d(Math.Min(point1.X, point2.X), Math.Max(point1.Y, point2.Y))
pLine.AddVertexAt(0, p1, 0, 0, 0)
pLine.AddVertexAt(0, p2, 0, 0, 0)
pLine.AddVertexAt(0, p3, 0, 0, 0)
pLine.AddVertexAt(0, p4, 0, 0, 0)
pLine.Closed = True
pLine.ConstantWidth = 0
Return db.AddEntityToModelspace(pLine)
End Function
'''
''' 多边形
'''
''' 图形数据库
''' 中心点
''' 半径
''' 边数
''' ObjectId
Public Function AddPolygonToModelspace(db As Database, center As Point2d, radius As Double, sideNum As Integer, Optional offsetDegree As Double = 0) As ObjectId
'声明多段线对象
Dim pLine As Polyline = New Polyline()
'判断边数是否符合要求
If sideNum < 3 Then
Return ObjectId.Null
End If
Dim points(sideNum - 1) As Point2d
Dim angle = 2 * Math.PI / sideNum
Dim off = offsetDegree.DegreeToAngle
Dim x, y As Double
For i As Integer = 0 To sideNum - 1
x = center.X + radius * Math.Cos(angle * i + off)
y = center.Y + radius * Math.Sin(angle * i + off)
points(i) = New Point2d(x, y)
pLine.AddVertexAt(i, points(i), 0, 0, 0)
Next
pLine.Closed = True
Return db.AddEntityToModelspace(pLine)
End Function
'''
''' 绘制椭圆
'''
''' 图形数据库
''' 中心点
''' 长轴长度
''' 短轴长度
''' 长轴与X轴正方向夹角
''' 起始角度0-360
''' 结束角度0-360
'''
Public Function AddEllipseToModelspace(ByVal db As Database, ByVal center As Point3d, ByVal majorRadius As Double, ByVal shortRadius As Double, ByVal degree As Double, Optional ByVal startDegree As Double = 0, Optional ByVal endDegree As Double = 360) As ObjectId
Dim ratio As Double = shortRadius / majorRadius
Dim majorAxis As Vector3d = New Vector3d(majorRadius * Math.Cos(degree.DegreeToAngle()), majorRadius * Math.Sin(degree.DegreeToAngle()), 0)
Dim elli As Ellipse = New Ellipse(center, Vector3d.ZAxis, majorAxis, ratio, startDegree.DegreeToAngle(), endDegree.DegreeToAngle())
Return db.AddEntityToModelspace(elli)
End Function
'''
''' 绘制椭圆 提供长轴两点和短轴的一半长度
'''
''' 图形数据库
''' 长轴端点1
''' 长轴端点2
''' 短轴长度的一半
'''
Public Function AddEllipseToModelspace(ByVal db As Database, ByVal majorPoint1 As Point3d, ByVal majorPoint2 As Point3d, ByVal shortRadius As Double) As ObjectId
Dim center As Point3d = majorPoint1.GetCenterPointBetweenTwoPoint(majorPoint2)
Dim ratio As Double = 2 * shortRadius / majorPoint1.GetDistanceBetweenTwoPoint(majorPoint2)
Dim majorAxis As Vector3d = majorPoint2.GetVectorTo(center)
Dim elli As Ellipse = New Ellipse(center, Vector3d.ZAxis, majorAxis, ratio, 0, 2 * Math.PI)
Return db.AddEntityToModelspace(elli)
End Function
'''给出矩形数据如何画椭圆
''' 难点，当ratio比例大于1时应当如何处理才能正常画出需要的椭圆
''' 开始默认 水平方向长度比垂直方向的轴长，那就用短轴比长轴可得出比例，同时长轴在X方向上体现
''' 比例大于1时，说明垂直方向的轴长，长轴应在Y轴上体现，此时比率取倒数计可
''' 绘制椭圆，给出矩形推出内切椭圆
'''
''' 图形数据库
''' 点1
''' 点2
'''
Public Function AddEllipseToModelspace(ByVal db As Database, ByVal point1 As Point3d, ByVal point2 As Point3d) As ObjectId
Dim center As Point3d = point1.GetCenterPointBetweenTwoPoint(point2)
Dim ratio As Double = Math.Abs((point1.Y - point2.Y) / (point1.X - point2.X))
Dim majorVector As Vector3d
If ratio <= 1 Then
majorVector = New Vector3d(Math.Abs((point1.X - point2.X)) / 2, 0, 0)
Else
majorVector = New Vector3d(0, Math.Abs((point1.Y - point2.Y)) / 2, 0)
ratio = 1 / ratio
End If
Dim elli As Ellipse = New Ellipse(center, Vector3d.ZAxis, majorVector, ratio, 0, 2 * Math.PI)
Return db.AddEntityToModelspace(elli)
End Function
Public Structure HatchPatterName
Public Const solid As String = "SOLID"
Public Const angle As String = "angle"
Public Const ansi31 As String = "ansi31"
Public Const ansi32 As String = "ansi32"
Public Const ansi33 As String = "ansi33"
Public Const ansi34 As String = "ansi34"
Public Const ansi35 As String = "ansi35"
Public Const ansi36 As String = "ansi36"
Public Const ansi37 As String = "ansi37"
Public Const ansi38 As String = "ansi38"
Public Const arb816 As String = "arb816"
Public Const arb816c As String = "arb816c"
Public Const arbrelm As String = "ar-brelm"
Public Const arbrstd As String = "ar-brstd"
Public Const arconc As String = "ar-conc"
End Structure
#Disable Warning BC42304 ' XML 文档分析错误
'''
''' 图案填充
'''
''' 图形数据库
''' 边界图形的ObjectID
''' 前景色索引1--9
''' 背景颜色 此色是autoCAD的色类，调用前先(RGB)色 color.fromRGB
''' 图案名称
''' 设置填充比例 密度，值越小，越密
''' 填充角度
''' 返回填充对象的id
Public Function HatchEnity(db As Database, entid As ObjectId, Optional hatchColorIndex As Integer = 1, Optional bkcolor As Color = Nothing, Optional patternName As String = HatchPatterName.solid, Optional scale As Double = 0, Optional degree As Double = 0) As ObjectId
#Enable Warning BC42304 ' XML 文档分析错误
If bkcolor = Nothing Then bkcolor = Color.FromRgb(0, 0, 0) '默认值'
Dim hatchId As ObjectId
Using trans As Transaction = db.TransactionManager.StartTransaction '库 事务处理 开始工作
'声明图案填充对象
'设置填充比例
'设置填充的前景色序 autocad要求的颜色没那么细
'设置背景色，用的是autoCAD自带的色类
Dim hatch As New Hatch With {
.PatternScale = scale,
.ColorIndex = hatchColorIndex,
.BackgroundColor = bkcolor
}
'设置填充类型和图案名
hatch.SetHatchPattern(HatchPatternType.PreDefined, patternName)
'加入到图形数据库当中
Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead) '打开块表
Dim btr As BlockTableRecord = CType(trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord) '打开块记录
hatchId = btr.AppendEntity(hatch) '加entity实体对象到块表记录中,并返回填充对象的id
trans.AddNewlyCreatedDBObject(hatch, True) '添加新建立的对象hatch ,true代表加进去
'设置填充角度
hatch.PatternAngle = degree.DegreeToAngle
'关联
hatch.Associative = True
'声明一个对象集合
Dim obids As New ObjectIdCollection
'对象id入集合
obids.Add(entid)
'设置边界图形和填充方式
hatch.AppendLoop(HatchLoopTypes.Outermost, obids)
'计算填充并显示效果
hatch.EvaluateHatch(True)
'提前事务
trans.Commit()
End Using '库事务处理结束工作
End Function
'''
''' 图案填充
'''
''' 数据库
''' 图案名称
''' 填充比例
''' 填充比例
''' 旋转角度
''' 边界图形的objectid
''' objectid
Public Function HatchEnity(ByVal db As Database, ByVal loopTypes As List(Of HatchLoopTypes), ByVal patternName As String, ByVal scale As Double, ByVal degree As Double, ParamArray entid As ObjectId()) As ObjectId
Dim hatchId As ObjectId = ObjectId.Null
Using trans As Transaction = db.TransactionManager.StartTransaction()
'声明填充对象
Dim hatch As Hatch = New Hatch()
'设置填充比例
hatch.PatternScale = scale
'设置填充类型和图案名
hatch.SetHatchPattern(HatchPatternType.PreDefined, patternName)
'打开块表
Dim bt As BlockTable = CType(trans.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
'打开块表中的记录
Dim btr As BlockTableRecord = CType(trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
'填充对象入表记录并返回填充对象的id
hatchId = btr.AppendEntity(hatch)
'把对象添加到事务中
trans.AddNewlyCreatedDBObject(hatch, True)
'填充角度
hatch.PatternAngle = degree.DegreeToAngle
'设置关联
hatch.Associative = True
Dim obIds As ObjectIdCollection = New ObjectIdCollection()
For i As Integer = 0 To entid.Length - 1
obIds.Clear()
obIds.Add(entid(i))
hatch.AppendLoop(loopTypes(i), obIds)
Next
'计算填充并显示
hatch.EvaluateHatch(True)
'提交事务
trans.Commit()
End Using '事务结束
Return hatchId
End Function
'''
''' 图案填充
'''
''' 数据库
''' 填充比例
''' 填充比例
''' 旋转角度
''' 边界图形的objectid
''' objectid
Public Function HatchEnity(ByVal db As Database, ByVal patternName As String, ByVal scale As Double, ByVal degree As Double, ParamArray entid As ObjectId()) As ObjectId
Dim hatchId As ObjectId = ObjectId.Null
Using trans As Transaction = db.TransactionManager.StartTransaction()
'声明填充对象
Dim hatch As Hatch = New Hatch()
'设置填充比例
hatch.PatternScale = scale
'设置填充类型和图案名
hatch.SetHatchPattern(HatchPatternType.PreDefined, patternName)
'打开块表
Dim bt As BlockTable = CType(trans.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
'打开块表中的记录
Dim btr As BlockTableRecord = CType(trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
'填充对象入表记录并返回填充对象的id
hatchId = btr.AppendEntity(hatch)
'把对象添加到事务中
trans.AddNewlyCreatedDBObject(hatch, True)
'填充角度
hatch.PatternAngle = degree.DegreeToAngle
'设置关联
hatch.Associative = True
Dim obIds As ObjectIdCollection = New ObjectIdCollection()
For i As Integer = 0 To entid.Length - 1
obIds.Clear()
obIds.Add(entid(i))
hatch.AppendLoop(HatchLoopTypes.Outermost, obIds)
Next
'计算填充并显示
hatch.EvaluateHatch(True)
'提交事务
trans.Commit()
End Using '事务结束
Return hatchId
End Function
Public Structure HatchGradientName
Public Const Linear As String = "Linear" '线状
Public Const Cylinder As String = "ConstCylinder" '圆柱
Public Const Invcylinder As String = "Invcylinder" '反圆柱
Public Const Spherical As String = "Spherical" '球状
Public Const Invspherical As String = "Invspherical" '反球状
Public Const Hemisperical As String = "Hemisperical" '半球
Public Const InvHemisperical As String = "InvHemisperical" '反半球
Public Const Curved As String = "Curved" '抛物线
Public Const Incurved As String = "Incurved" '反抛物线
End Structure
Public Enum StackType
'''
''' 水平分数(/)
'''
HorizontalFraction
'''
''' 斜分数(#)
'''
ItalicFraction
'''
''' 公差(^)
'''
Tolerance
End Enum
Public Structure 文本特殊符号
Public Shared ReadOnly 度符号 As String = "U+00B0"
Public Shared ReadOnly 公差符号 As String = "U+00B1"
Public Shared ReadOnly 直径符号 As String = "U+2205"
Public Shared ReadOnly 几乎相等 As String = "U+2248"
Public Shared ReadOnly 角度 As String = "U+2220"
Public Shared ReadOnly 边界线 As String = "U+E100"
Public Shared ReadOnly 中心线 As String = "U+2104"
Public Shared ReadOnly 增量 As String = "U+0394"
Public Shared ReadOnly 电相位 As String = "U+0278"
Public Shared ReadOnly 流线 As String = "U+E101"
Public Shared ReadOnly 标识 As String = "U+2261"
Public Shared ReadOnly 初始长度 As String = "U+E200"
Public Shared ReadOnly 界碑线 As String = "U+E102"
Public Shared ReadOnly 不相等 As String = "U+2260"
Public Shared ReadOnly 欧姆 As String = "U+2126"
Public Shared ReadOnly 欧米加 As String = "U+03A9"
Public Shared ReadOnly 地界线 As String = "U+214A"
Public Shared ReadOnly 下标2 As String = "U+2082"
Public Shared ReadOnly 平方 As String = "U+00B2"
Public Shared ReadOnly 立方 As String = "U+00B3"
Public Shared ReadOnly 单行文字上划线 As String = "%%o"
Public Shared ReadOnly 单行文字下划线 As String = "%%u"
Public Shared ReadOnly 阿尔法 As String = "U+03B1"
Public Shared ReadOnly 贝塔 As String = "U+03B2"
Public Shared ReadOnly 伽马 As String = "U+03B3"
Public Shared ReadOnly 一级钢筋符号 As String = "U+0082"
Public Shared ReadOnly 二级钢筋符号 As String = "U+0083"
Public Shared ReadOnly 三级钢筋符号 As String = "U+0084"
Public Shared ReadOnly 四级钢筋符号 As String = "U+0085"
Public ReadOnly Property Ab() As String
Get
Return 1
End Get
End Property
End Structure
Public Structure TextSpecialSymbol
'''
''' 度符号(°)
'''
Public Shared ReadOnly Degree As String = "U+00B0"
'''
''' 公差符号(±)
'''
Public Shared ReadOnly Tolerance As String = "U+00B1"
Public Shared ReadOnly Diameter As String = "U+2205"
Public Shared ReadOnly AlmostEqual As String = "U+2248"
Public Shared ReadOnly Angle As String = "U+2220"
Public Shared ReadOnly LineBoundary As String = "U+E100"
Public Shared ReadOnly LineCenter As String = "U+2104"
Public Shared ReadOnly Delta As String = "U+0394"
Public Shared ReadOnly ElectricalPhase As String = "U+0278"
Public Shared ReadOnly LineFlow As String = "U+E101"
Public Shared ReadOnly Identity As String = "U+2261"
Public Shared ReadOnly InitialLength As String = "U+E200"
Public Shared ReadOnly LineMonument As String = "U+E102"
Public Shared ReadOnly Notequal As String = "U+2260"
Public Shared ReadOnly Ohm As String = "U+2126"
Public Shared ReadOnly Omega As String = "U+03A9"
Public Shared ReadOnly LinePlate As String = "U+214A"
Public Shared ReadOnly Subscript2 As String = "U+2082"
Public Shared ReadOnly Square As String = "U+00B2"
Public Shared ReadOnly Cube As String = "U+00B3"
Public Shared ReadOnly Overline As String = "%%o"
Public Shared ReadOnly Underline As String = "%%u"
Public Shared ReadOnly Alpha As String = "U+03B1"
Public Shared ReadOnly Belta As String = "U+03B2"
Public Shared ReadOnly Gamma As String = "U+03B3"
Public Shared ReadOnly SteelBar1 As String = "U+0082"
Public Shared ReadOnly SteelBar2 As String = "U+0083"
Public Shared ReadOnly SteelBar3 As String = "U+0084"
Public Shared ReadOnly SteelBar4 As String = "U+0085"
End Structure
'''
''' 渐变图形
'''
''' 数据库
''' 颜色索引1
''' 颜色索引2
''' 渐变图案
''' 图形id
''' objectid
Public Function HatchGradient(ByVal db As Database, ByVal colorIndex1 As Short, ByVal colorIndex2 As Short, ByVal hatchGradientName As String, ParamArray entid As ObjectId()) As ObjectId
Dim hatchId As ObjectId = ObjectId.Null
Using trans As Transaction = db.TransactionManager.StartTransaction()
Dim hatch As Hatch = New Hatch()
hatch.HatchObjectType = HatchObjectType.GradientObject
hatch.SetGradient(GradientPatternType.PreDefinedGradient, hatchGradientName)
Dim color1 As Color = Color.FromColorIndex(ColorMethod.ByColor, colorIndex1)
Dim color2 As Color = Color.FromColorIndex(ColorMethod.ByColor, colorIndex2)
Dim gColor1 As GradientColor = New GradientColor(color1, 0)
Dim gColor2 As GradientColor = New GradientColor(color2, 1)
hatch.SetGradientColors(New GradientColor() {gColor1, gColor2})
Dim bt As BlockTable = CType(trans.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
Dim btr As BlockTableRecord = CType(trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
hatchId = btr.AppendEntity(hatch)
trans.AddNewlyCreatedDBObject(hatch, True)
hatch.Associative = True
Dim obIds As ObjectIdCollection = New ObjectIdCollection()
For i As Integer = 0 To entid.Length - 1
obIds.Clear()
obIds.Add(entid(i))
hatch.AppendLoop(HatchLoopTypes.Outermost, obIds)
Next
hatch.EvaluateHatch(True)
trans.Commit()
End Using
Return hatchId
End Function
'''
''' 编辑实体的颜色
'''
''' 实体的id
''' 颜色的索引
Public Sub EditEntityColor(entId As ObjectId, colorIndex As Short)
Dim db As Database = HostApplicationServices.WorkingDatabase
Using trans As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = CType(trans.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
Dim btr As BlockTableRecord = CType(trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForRead), BlockTableRecord)
Dim ent As Entity = CType(entId.GetObject(OpenMode.ForWrite), Entity)
ent.ColorIndex = colorIndex
trans.Commit()
End Using
End Sub
'''
''' 编辑实体的颜色
'''
''' 实体类注意不是实体的id
''' 颜色索引
Public Sub EditEntityColor(ent As Entity, colorIndex As Short)
'判断 isNewObject :此属性反映的是否是已经建立过的对象
If ent.IsNewObject Then
ent.ColorIndex = colorIndex
Else
ent.ObjectId.EditEntityColor(colorIndex)
End If
End Sub
'''
''' 移动实体对象
'''
''' 实体id
''' 水平变化
''' 垂直变化
Public Sub MoveEntity(entId As ObjectId, x As Double, y As Double)
Dim db As Database = HostApplicationServices.WorkingDatabase
Using trans As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = CType(trans.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
Dim btr As BlockTableRecord = CType(trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForRead), BlockTableRecord)
Dim ent As Entity = CType(entId.GetObject(OpenMode.ForWrite), Entity)
'计算变换矩阵 sourcePoint 0,0,0 targetPoint x,y,0
Dim sourcePoint = Point(0, 0)
Dim targetPoint = Point(x, y)
'矢量 有方向的平面偏移
'dim vector1 as vector3d =Vector3(x,y)
Dim vector As Vector3d = sourcePoint.GetVectorTo(targetPoint)
'矢量转矩阵
Dim mt As Matrix3d = Matrix3d.Displacement(vector) '取代，代替 转换
ent.TransformBy(mt) '根据矩阵信息转移
ent.DowngradeOpen()
trans.Commit()
End Using
End Sub
'''
''' 移动实体对象
'''
''' 实体类注意不是实体的id
''' 水平变化
''' 垂直变化
Public Sub MoveEntity(ent As Entity, x As Double, y As Double)
'判断 isNewObject :此属性反映的是否是已经建立过的对象
If ent.IsNewObject Then
'计算变换矩阵 sourcePoint 0,0,0 targetPoint x,y,0
Dim sourcePoint = Point(0, 0)
Dim targetPoint = Point(x, y)
'矢量 有方向的平面偏移
'dim vector1 as vector3d =Vector3(x,y)
Dim vector As Vector3d = sourcePoint.GetVectorTo(targetPoint)
'矢量转矩阵
Dim mt As Matrix3d = Matrix3d.Displacement(vector)
ent.TransformBy(mt)
Else
ent.ObjectId.MoveEntity(x, y)
End If
End Sub
'''
''' 复制实体对象
'''
''' 实体id
''' 水平变化
''' 垂直变化
''' objectID
Public Function CopyEntity(entId As ObjectId, x As Double, y As Double) As ObjectId
'声明一个图形对象
Dim id As ObjectId = ObjectId.Null
Dim db As Database = HostApplicationServices.WorkingDatabase
Using trans As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = CType(trans.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
Dim btr As BlockTableRecord = CType(trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForRead), BlockTableRecord)
Dim ent As Entity = CType(entId.GetObject(OpenMode.ForWrite), Entity)
'计算变换矩阵 sourcePoint 0,0,0 targetPoint x,y,0
Dim sourcePoint = Point(0, 0)
Dim targetPoint = Point(x, y)
'矢量 有方向的平面偏移
'dim vector1 as vector3d =Vector3(x,y)
Dim vector As Vector3d = sourcePoint.GetVectorTo(targetPoint)
'矢量转矩阵
Dim mt As Matrix3d = Matrix3d.Displacement(vector)
Dim entReturn As Entity = ent.GetTransformedCopy(mt) '根据矩阵信息复制
'将复制的实体对象添加到模型空间
id = db.AddEntityToModelspace(entReturn)
trans.Commit()
End Using
Return id
End Function
'''
''' 复制实体对象
'''
''' 实体对象并非id
''' 水平变化
''' 垂直变化
''' Entity
Public Function CopyEntity(ent As Entity, x As Double, y As Double) As ObjectId
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim id As ObjectId = ObjectId.Null
'判断 isNewObject :此属性反映的是否是已经建立过的对象
If ent.IsNewObject Then
'计算变换矩阵 sourcePoint 0,0,0 targetPoint x,y,0
Dim sourcePoint = Point(0, 0)
Dim targetPoint = Point(x, y)
'矢量 有方向的平面偏移
'dim vector1 as vector3d =Vector3(x,y)
Dim vector As Vector3d = sourcePoint.GetVectorTo(targetPoint)
'矢量转矩阵
Dim mt As Matrix3d = Matrix3d.Displacement(vector)
Dim entReturn As Entity = ent.GetTransformedCopy(mt)
db.AddEntityToModelspace(entReturn)
id = entReturn.ObjectId
Else
'声明一个图形对象
id = ent.ObjectId.CopyEntity(x, y)
End If
Return id
End Function
'''
''' 复制原始对象产生一组新的对象，提供ID的说明已经显示的
'''
''' 图形id
''' 一组偏移值
''' 一组对象id
Public Function CopyEntity(Id As ObjectId, ParamArray lists() As Point3d) As ObjectId()
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim entID() As ObjectId
ReDim entID(lists.Count - 1)
Using trans As Transaction = db.TransactionManager.StartTransaction '开启事务处理
Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead) '打开块表
Dim btr As BlockTableRecord = trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite) '打开块记录
Dim ent As Entity = CType(Id.GetObject(OpenMode.ForWrite), Entity)
Dim i As Integer = 0
For i = 0 To lists.Count - 1
Dim sourcePoint = Point(0, 0)
Dim targetPoint = Point(lists(i).X, lists(i).Y)
Dim vector As Vector3d = sourcePoint.GetVectorTo(targetPoint)
Dim mt As Matrix3d = Matrix3d.Displacement(vector)
Dim entReturn As Entity = ent.GetTransformedCopy(mt) '根据矩阵信息复制
entID(i) = btr.AppendEntity(entReturn)
trans.AddNewlyCreatedDBObject(entReturn, True)
entID(i) = entReturn.ObjectId
Next
trans.Commit()
End Using
Return entID
End Function
'''
''' 复制原始对象产生一组新的对象 如果原始对象没有显示的处理，如果显示的直接传id调用重构即可
'''
''' 原始对象
''' 一组偏移
''' 一组对象的id
Public Function CopyEntity(ent As Entity, ParamArray lists() As Point3d) As ObjectId()
Dim id As ObjectId = ObjectId.Null
'判断 isNewObject :此属性反映的是否是已经建立过的对象
If ent.IsNewObject Then
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim entID() As ObjectId
ReDim entID(lists.Count - 1)
Using trans As Transaction = db.TransactionManager.StartTransaction '开启事务处理
Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead) '打开块表
Dim btr As BlockTableRecord = trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite) '打开块记录
Dim i As Integer = 0
For i = 0 To lists.Count - 1
Dim sourcePoint = Point(0, 0)
Dim targetPoint = Point(lists(i).X, lists(i).Y)
Dim vector As Vector3d = sourcePoint.GetVectorTo(targetPoint)
Dim mt As Matrix3d = Matrix3d.Displacement(vector)
Dim entReturn As Entity = ent.GetTransformedCopy(mt) '根据矩阵信息复制
entID(i) = btr.AppendEntity(entReturn)
trans.AddNewlyCreatedDBObject(entReturn, True)
entID(i) = entReturn.ObjectId
Next
trans.Commit()
End Using
Return entID
Else
'声明一个图形对象
Return ent.ObjectId.CopyEntity(lists)
End If
End Function
'''
''' 旋转图形
'''
''' 图形对象id
''' 旋转中心点
''' 转多少角度
Public Sub RotateEntity(entID As ObjectId, center As Point3d, degree As Double)
Dim db As Database = HostApplicationServices.WorkingDatabase
Using trans As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = CType(trans.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
Dim btr As BlockTableRecord = CType(trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForRead), BlockTableRecord)
Dim ent As Entity = CType(entID.GetObject(OpenMode.ForWrite), Entity)
'计算变换转矩阵
Dim mt As Matrix3d = Matrix3d.Rotation(degree.DegreeToAngle, Vector3d.ZAxis, center)
ent.TransformBy(mt) '根据矩阵信息转移
ent.DowngradeOpen()
trans.Commit()
End Using
End Sub
'''
''' 旋转图形
'''
''' 图形对象
''' 旋转中心点
''' 转多少角度
Public Sub RotateEntity(ent As Entity, center As Point3d, degree As Double)
'判断 isNewObject :此属性反映的是否是已经建立过的对象
If ent.IsNewObject Then
'计算变换转矩阵
Dim mt As Matrix3d = Matrix3d.Rotation(degree.DegreeToAngle, Vector3d.ZAxis, center)
ent.TransformBy(mt) '根据矩阵信息转移
Else
ent.ObjectId.RotateEntity(center, degree)
End If
End Sub
'''
''' 镜像图形
'''
''' 图形对象的ObjectId
''' 第一个镜像点
''' 第二个镜像点
''' 是否删除原图形
''' 返回新的图形对象 加入图形数据库的情况
Public Function MirrorEntity(ByVal entId As ObjectId, ByVal point1 As Point3d, ByVal point2 As Point3d, ByVal isEraseSource As Boolean) As Entity
'声明一个图形对象用于返回
Dim entR As Entity
Dim mt As Matrix3d = Matrix3d.Mirroring(New Line3d(point1, point2))
Using trans As Transaction = entId.Database.TransactionManager.StartTransaction()
'判断是否删除原对象
If isEraseSource Then
'打开对象
Dim ent As Entity = CType(trans.GetObject(entId, OpenMode.ForWrite), Entity)
'执行变换
ent.TransformBy(mt) '所谓的删其实指的是移动之前的到新位置
entR = ent
Else
Dim ent As Entity = CType(trans.GetObject(entId, OpenMode.ForRead), Entity)
entR = ent.GetTransformedCopy(mt) '不删其实是复制一份新的到新位置
End If
Return entR
End Using
End Function
'''
''' 镜像图形
'''
''' 图形对象的ObjectId
''' 第一个镜像点
''' 第二个镜像点
''' 是否删除原图形
''' 返回新的图形对象 没有加入图形数据库的情况
Public Function MirrorEntity(ByVal ent As Entity, ByVal point1 As Point3d, ByVal point2 As Point3d, ByVal isEraseSource As Boolean) As Entity
Dim entR As Entity
If ent.IsNewObject = True Then
Dim mt As Matrix3d = Matrix3d.Mirroring(New Line3d(point1, point2))
entR = ent.GetTransformedCopy(mt)
Else
entR = ent.ObjectId.MirrorEntity(point1, point2, isEraseSource)
End If
Return entR
End Function
'''
''' 缩放图形 图形已经加到图形数据库中
'''
''' 图形对象的ObjectId
''' 缩放的基点
''' 缩放比例
Public Sub ScaleEntity(ByVal entId As ObjectId, ByVal basePoint As Point3d, ByVal facter As Double)
'' 计算缩放矩阵
Dim mt As Matrix3d = Matrix3d.Scaling(facter, basePoint)
'' 启动事务处理
Using trans As Transaction = entId.Database.TransactionManager.StartTransaction()
'' 打开要缩放的图形对象
Dim ent As Entity = CType(entId.GetObject(OpenMode.ForWrite), Entity)
ent.TransformBy(mt)
trans.Commit()
End Using
End Sub
'''
''' 缩放图形 图形已经加到图形数据库中
'''
''' 图形对象的
''' 缩放的基点
''' 缩放比例
Public Sub ScaleEntity(ByVal ent As Entity, ByVal basePoint As Point3d, ByVal facter As Double)
'' 判断图形对象的IsNewlyObject属性
If ent.IsNewObject = True Then
'' 打开要缩放的图形对象
Dim mt As Matrix3d = Matrix3d.Scaling(facter, basePoint)
ent.TransformBy(mt)
Else
ent.ObjectId.ScaleEntity(basePoint, facter)
End If
End Sub
'''
''' 删除图形对象
'''
''' 图形对象的ObjectId
Public Sub EraseEntity(ByVal entId As ObjectId)
'' 打开事务处理
Using trans As Transaction = entId.Database.TransactionManager.StartTransaction()
'' 打开要删除的图形对象
Dim ent As Entity = CType(entId.GetObject(OpenMode.ForWrite), Entity)
ent.[Erase]()
trans.Commit()
End Using
End Sub
'''
''' 矩形阵列
'''
''' 图形对象的ObjectId
''' 行数
''' 列数
''' 行间距
''' 列间距
''' List 已加入图形数据库
Public Function ArrayRectEntity(ByVal entId As ObjectId, ByVal rowNum As Integer, ByVal columnNum As Integer, ByVal disRow As Double, ByVal disColumn As Double) As List(Of Entity)
'声明一个Entity类型集合 用于返回
Dim entList As List(Of Entity) = New List(Of Entity)()
'当前图形数据库
Dim db As Database = HostApplicationServices.WorkingDatabase
'开始事务
Using trans As Transaction = db.TransactionManager.StartTransaction()
'打开块表
Dim bt As BlockTable = CType(trans.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
'打开表记录
Dim btr As BlockTableRecord = CType(trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
'打开图形
Dim ent As Entity = CType(entId.GetObject(OpenMode.ForWrite), Entity)
'计算变换矩阵
For i As Integer = 0 To rowNum - 1
For j As Integer = 0 To columnNum - 1
Dim mt As Matrix3d = Matrix3d.Displacement(New Vector3d(j * disColumn, i * disRow, 0))
Dim entA As Entity = ent.GetTransformedCopy(mt)
btr.AppendEntity(entA)
trans.AddNewlyCreatedDBObject(entA, True)
entList.Add(entA)
Next
Next
'删除多余图形
ent.[Erase]()
trans.Commit()
End Using
Return entList
End Function
'''
''' 矩形阵列
'''
''' 图形对象
''' 行数
''' 列数
''' 行间距
''' 列间距
''' List 没有加入图形数据库
Public Function ArrayRectEntity(ByVal entS As Entity, ByVal rowNum As Integer, ByVal columnNum As Integer, ByVal disRow As Double, ByVal disColumn As Double) As List(Of Entity)
If entS.IsNewObject = True Then
'声明一个Entity类型集合 用于返回
Dim entList As List(Of Entity) = New List(Of Entity)()
Dim db As Database = HostApplicationServices.WorkingDatabase
Using trans As Transaction = db.TransactionManager.StartTransaction()
'打开块表
Dim bt As BlockTable = CType(trans.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
'打开块表记录
Dim btr As BlockTableRecord = CType(trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
For i As Integer = 0 To rowNum - 1
For j As Integer = 0 To columnNum - 1
Dim mt As Matrix3d = Matrix3d.Displacement(New Vector3d(j * disColumn, i * disRow, 0))
Dim entA As Entity = entS.GetTransformedCopy(mt)
btr.AppendEntity(entA)
trans.AddNewlyCreatedDBObject(entA, True)
entList.Add(entA)
Next
Next
trans.Commit()
End Using
Return entList
Else
Return entS.ArrayRectEntity(rowNum, columnNum, disRow, disColumn)
End If
End Function
'''
''' 环形阵列
'''
''' 图形对象的ObjectId
''' 图形数量
''' 中心点到各个图形的夹角
''' 中心点
''' List 已经加入图形数据库
Public Function ArrayPolarEntity(ByVal entId As ObjectId, ByVal num As Integer, ByVal degree As Double, ByVal center As Point3d) As List(Of Entity)
'声明一个List集合 用于返回
Dim entList As List(Of Entity) = New List(Of Entity)()
'打开事务
Using trans As Transaction = entId.Database.TransactionManager.StartTransaction()
'打开块表
Dim bt As BlockTable = CType(trans.GetObject(entId.Database.BlockTableId, OpenMode.ForRead), BlockTable)
'打开块表记录
Dim btr As BlockTableRecord = CType(trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
'获取对象
Dim ent As Entity = CType(entId.GetObject(OpenMode.ForWrite), Entity)
'限定阵列角度大小
degree = If(degree > 360, 360, degree)
degree = If(degree < -360, 360, degree)
Dim divAngnum As Integer = num - 1
If degree = 360 OrElse degree = -360 Then
divAngnum = num
End If
For i As Integer = 0 To num - 1
Dim mt As Matrix3d = Matrix3d.Rotation((i * degree / divAngnum).DegreeToAngle(), Vector3d.ZAxis, center)
Dim entA As Entity = ent.GetTransformedCopy(mt)
btr.AppendEntity(entA)
trans.AddNewlyCreatedDBObject(entA, True)
entList.Add(entA)
Next
ent.[Erase]()
trans.Commit()
End Using
Return entList
End Function
'''
''' 环形阵列
'''
''' 图形对象
''' 图形数量
''' 中心点到各个图形的夹角
''' 中心点
''' List 已经加入图形数据库
Public Function ArrayPolarEntity(ByVal ent As Entity, ByVal num As Integer, ByVal degree As Double, ByVal center As Point3d) As List(Of Entity)
If ent.IsNewObject = True Then '参数进来的对象不在数据库里
' 声明一个List集合 用于返回
Dim entList As List(Of Entity) = New List(Of Entity)()
Dim db As Database = HostApplicationServices.WorkingDatabase
'打开事务
Using trans As Transaction = db.TransactionManager.StartTransaction()
'打开块
Dim bt As BlockTable = CType(trans.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
'打开块表
Dim btr As BlockTableRecord = CType(trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
degree = If(degree > 360, 360, degree)
degree = If(degree < -360, -360, degree)
Dim divAngnum As Integer = num - 1
If degree = 360 OrElse degree = -360 Then
divAngnum = num
End If
For i As Integer = 0 To num - 1
Dim mt As Matrix3d = Matrix3d.Rotation((i * degree / divAngnum).DegreeToAngle(), Vector3d.ZAxis, center)
Dim entA As Entity = ent.GetTransformedCopy(mt)
btr.AppendEntity(entA)
trans.AddNewlyCreatedDBObject(entA, True)
entList.Add(entA)
Next
trans.Commit()
End Using
Return entList
Else
Return ent.ObjectId.ArrayPolarEntity(num, degree, center)
End If
End Function
'''
''' 获取点
'''
''' 命令行对象
''' 提示信息
''' PromptPointResult
Public Function GetPoint2(ByVal ed As Editor, ByVal promptStr As String) As PromptPointResult
'声明一个获取点的提示类
Dim ppo As PromptPointOptions = New PromptPointOptions(promptStr)
'使回车和空格键有效
ppo.AllowNone = True
Return ed.GetPoint(ppo)
End Function
'''
''' 获取图形实体对象
'''
''' 图形实体的id
''' 实体
Public Function GetEntity(entId As ObjectId) As Entity
Dim ent As Entity
Using trans As Transaction = entId.Database.TransactionManager.StartTransaction()
ent = CType(entId.GetObject(OpenMode.ForRead), Entity)
End Using
Return ent
End Function
'''
''' 获取直线的定距等分点
'''
''' 直线对象
''' 等分数量
''' List(Of Point3d)
Public Function GetBaseLineDivPoints(line As Line, divNum As Integer) As List(Of Point3d)
Return GetBaseLineDivPoints(line, line.Length / divNum)
End Function
'''
''' 获取直线的定距等分点
'''
''' 直线对象
''' 等分距离
''' List(Of Point3d)
Public Function GetBaseLineDivPoints(line As Line, divDist As Double) As List(Of Point3d)
'声明一个Point3d点列表
Dim points As New List(Of Point3d)
'根据 divDist得出需要多个段
Dim divNum As Integer = line.Length divDist
'取线的起点 和角度
Dim startPoint As Point3d = line.StartPoint
Dim angle As Double = line.Angle
points.Add(line.StartPoint)
For i As Integer = 1 To divNum
points.Add(PolarPoint(startPoint, divDist, angle))
divDist *= i
Next
If divDist * divNum <> line.Length Then
points.Add(line.EndPoint)
End If
End Function
'''
''' 获取Polar点坐标
'''
''' 起点坐标
''' 终点到起点的距离
''' 起点到终点的线与X轴正方向的弧度
''' Point3d
Private Function PolarPoint(starPoint As Point3d, dist As Double, angle As Double) As Point3d
Dim x As Double = starPoint.X + dist * Math.Cos(angle)
Dim y As Double = starPoint.Y + dist * Math.Sin(angle)
Return Point(x, y)
End Function
'''
''' 获取点或关键字
'''
''' 命令行
''' 提示信息
''' 基准点
''' 关键字
''' PromptPointResult
Public Function GetPoint(ByVal ed As Editor, ByVal promptStr As String, ByVal pointBase As Point3d, ParamArray keyWord As String()) As PromptPointResult
'声明一个获取点的提示类
Dim ppo As PromptPointOptions = New PromptPointOptions(promptStr)
'使回车和空格键有效
ppo.AllowNone = True
'添加字符是的相应的字符按键有效
For i As Integer = 0 To keyWord.Length - 1
ppo.Keywords.Add(keyWord(i))
Next
'取消系统自动关键字显示
ppo.AppendKeywordsToMessage = False
' 设置基准点
ppo.BasePoint = pointBase
ppo.UseBasePoint = True
ppo.UseDashedLine = False
Return ed.GetPoint(ppo)
End Function
'''
''' 堆叠多行文字
'''
''' 堆叠分数前的文字
''' 堆叠分数的分子
''' 堆叠分数的分母
''' 堆叠类型
''' 堆叠文字的缩放比例
''' 返回堆叠好的文字
Public Function StackText(ByVal text As String, ByVal supText As String, ByVal subText As String, ByVal stackType As StackType, ByVal scale As Double) As String
Dim strs As String() = New String() {"/", "#", "^"}
Return String.Format("A1;{0}{1}H{2:0.#}x;S{3}{4}{5};{6}", text, "{", scale, supText, strs(CInt(stackType)), subText, "}")
End Function
'''
''' 取得图层下的所有对象id
'''
''' 图层名称
''' id集合
Public Function GetObjectIdsAtLayer(ByVal name As String) As ObjectIdCollection
Dim ids As ObjectIdCollection = New ObjectIdCollection()
Dim ProSset As PromptSelectionResult = Nothing
Dim filList As TypedValue() = New TypedValue(0) {New TypedValue(CInt(DxfCode.LayerName), name)}
Dim sfilter As SelectionFilter = New SelectionFilter(filList)
Dim ed As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
ProSset = ed.SelectAll(sfilter)
If ProSset.Status = PromptStatus.OK Then
Dim sst As SelectionSet = ProSset.Value
Dim oids As ObjectId() = sst.GetObjectIds()
For i As Integer = 0 To oids.Length - 1
'根据 两图形ID 提供对象
Dim baseEntity As Entity = oids(i).GetEntity()
If TypeOf baseEntity Is DBText Then
ids.Add(oids(i))
End If
Next
End If
Return ids
End Function
End Module
Imports System.Reflection
Imports System.Reflection.PropertyInfo
Imports System.Runtime.CompilerServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Partial Module BaseTool
Dim Property_name() As String = {"Diameter", "Center", "Area", "StartPoint", "EndPoint", "Circumference", "TotalAngle", "GeometricExtents",
"Length", "ConstantWidth", "NumberOfVertices", "EndParam", "Radius", "ReferenceVector"}
'''
''' 分析pinfo是否在Property_name中
'''
''' pinfo信息
''' 布尔值
Public Function IsInProperty(pinfo As String) As Boolean
For Each pname As String In Property_name
If pname = pinfo Then
Return True
End If
Next
Return False
End Function
'''
''' 通过反射遍历对象的属性信息，对有需要的写入文件d:a.txt
'''
''' d:Test_文件名
''' 要分析的对象参数
Public Sub ForeachClassProperties(filename As String, obj As Object)
Dim fn As String = "d:Test_" & filename & ".log"
Dim aa As System.IO.StreamWriter = New System.IO.StreamWriter(fn, False, System.Text.Encoding.UTF8)
aa.WriteLine(" " & obj.ToString & " ")
For Each pinfo As PropertyInfo In obj.[GetType]().GetProperties()
If pinfo.Name.IsInProperty Then
aa.WriteLine(pinfo.Name & "=" & pinfo.GetValue(obj, Nothing).ToString & " ")
End If
Next
'pinfo.PropertyType.IsGenericType 是否为泛类型
'pinfo.PropertyType.IsValueType 值类型
aa.WriteLine()
aa.WriteLine("IsValueType=True")
Try
For Each pinfo As PropertyInfo In obj.[GetType]().GetProperties()
If pinfo.CanRead Then
If pinfo.PropertyType.IsValueType Then
If pinfo.Name = "CompoundObjectTransform" Then
aa.WriteLine(pinfo.PropertyType.IsValueType & " " & pinfo.Name & "=" & "Nothing_err" & " ")
GoTo err
End If
aa.WriteLine(pinfo.Name & "=" & " " & pinfo.GetValue(obj, Nothing).ToString & " ")
err:
End If
End If
Next
Catch ex As Exception
aa.Close()
aa.Dispose()
End Try
aa.Close()
aa.Dispose()
System.Diagnostics.Process.Start(fn)
End Sub
'''
''' 通过反射遍历多个对象的属性信息，对有需要的写入文件d:a.txt
'''
''' 文件名
''' 对象集合
Public Sub ForeachClassProperties(filename As String, ParamArray objs As Object())
Dim fn As String = "d:Test_" & filename & ".log"
Dim aa As System.IO.StreamWriter = New System.IO.StreamWriter(fn, False, System.Text.Encoding.UTF8)
Dim i As Integer = 0
For i = 0 To objs.Count - 1
aa.WriteLine(i + 1 & ": " & objs(i).ToString & " ")
For Each pinfo As PropertyInfo In objs(i).[GetType]().GetProperties()
If pinfo.Name.IsInProperty Then
aa.WriteLine(pinfo.Name & "=" & pinfo.GetValue(objs(i), Nothing).ToString & " ")
End If
Next
aa.WriteLine()
Next
aa.Close()
aa.Dispose()
System.Diagnostics.Process.Start(fn)
End Sub
#Region "x,y平面坐标转为3d坐标代表的 x,y,0"
'''
''' x,y平面坐标转为3d坐标
'''
''' X坐标
''' Y坐标
''' Point3d类型的对象
Public Function Point(x As Double, y As Double) As Point3d
Return New Point3d(x, y, 0)
End Function
#End Region
#Region "x,y代表的三维法向量x,y,0"
'''
''' x,y平面坐标转为3d坐标
'''
''' X坐标
''' Y坐标
''' Point3d类型的对象
Public Function Vector3(x As Double, y As Double) As Vector3d
Return New Vector3d(x, y, 0)
End Function
#End Region
#Region "三维法向量"
'''
''' 三维向量
'''
''' Vector3d类型的对象
Public Function Normal() As Vector3d
Return New Vector3d(0, 0, 1)
End Function
#End Region
#Region "角度与弧度互转"
'''
''' 角度转弧度
'''
''' 角度值
''' 弧度
Public Function DegreeToAngle(ByVal degree As Double) As Double
Return degree * Math.PI / 180
End Function
'''
''' 弧度转角度
'''
''' 弧度值
''' 角度
Public Function AngleToDegree(ByVal angle As Double) As Double
Return angle * 180 / Math.PI
End Function
#End Region
#Region "判断三点是否在同一条直线上的方法"
'''
''' 判断三点是否在同一条直线上的方法
'''
''' 第一个点
''' 第二个点
''' 第三个点
''' 是或否
Public Function IsOnOneLine(firstPoint As Point3d, secondPoint As Point3d, thirdPoint As Point3d) As Boolean
Dim v21 As Vector3d = secondPoint.GetVectorTo(firstPoint)
Dim v23 As Vector3d = secondPoint.GetVectorTo(thirdPoint)
If v21.GetAngleTo(v23) = 0 Or v21.GetAngleTo(v23) = Math.PI Then
Return True
Else
Return False
End If
End Function
#End Region
#Region "两点形成的直线线段与水平方向求出的弧度"
'''
''' 两点形成的直线线段与水平方向求出的弧度
'''
''' 起点
''' 终点
''' 夹角,角度值
Public Function GetAngleToXaxis(startPoint As Point3d, endPoint As Point3d) As Double
'声明一个与X轴平行的向量
Dim temp As Vector3d = New Vector3d(1, 0, 0)
'获取起点到终点的向量
Dim Vstoe As Vector3d = startPoint.GetVectorTo(endPoint)
Return (Math.Sign(Vstoe.Y)) * temp.GetAngleTo(Vstoe) ' 水平方向 与 两点形成的夹角
End Function
#End Region
#Region "两点之间的距离"
'''
''' 获取两点之间的距离
'''
''' 点1
''' 点2
'''
Public Function GetDistanceBetweenTwoPoint(Point1 As Point3d, Point2 As Point3d) As Double
Return Math.Sqrt((Point1.X - Point2.X) ^ 2 + (Point1.Y - Point2.Y) ^ 2 + (Point1.Z - Point2.Z) ^ 2)
End Function
#End Region
#Region "获取两点的中心点"
'''
''' 获取两点的中心点
'''
''' 第一点
''' 第二点
''' 中心点
Public Function GetCenterPointBetweenTwoPoint(point1 As Point3d, point2 As Point3d) As Point3d
Return New Point3d((point1.X + point2.X) / 2, (point1.Y + point2.Y) / 2, (point1.Z + point2.Z) / 2)
End Function
#End Region
End Module
