Public Shared Function FuncReturnTypeLineCode(ByVal recTypeLine As LinetypeTableRecord) As String
FuncReturnTypeLineCode = "A"
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim tr As Transaction = db.TransactionManager.StartTransaction()
Using tr
Dim acBlkTbl As BlockTable = tr.GetObject(db.BlockTableId, OpenMode.ForRead)
Dim acBlkTblRec As BlockTableRecord = tr.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
'находим все штрихи и точки
Dim lenD As Integer = recTypeLine.NumDashes
If lenD > 0 Then
Try
For i As Integer = 0 To lenD - 1
Dim l As Double = 0
Dim indexShape As Integer = 0
Dim textVal As String = ""
Dim nameShape As String = ""
'находим значения
l = recTypeLine.DashLengthAt(i) 'длина штриха
indexShape = recTypeLine.ShapeNumberAt(i) 'индекс формы (0 - нет формы)
Try
textVal = recTypeLine.TextAt(i) 'читаем текст
Catch ex As Autodesk.AutoCAD.Runtime.Exception
End Try
If indexShape > 0 Then
Dim idTextStyleShape As ObjectId = recTypeLine.ShapeStyleAt(i)
Dim textStyleShape As TextStyleTableRecord = tr.GetObject(idTextStyleShape, OpenMode.ForRead)
If textStyleShape.IsShapeFile = True Then
Dim pShape As Autodesk.AutoCAD.DatabaseServices.Shape = New Autodesk.AutoCAD.DatabaseServices.Shape(Point3d.Origin, 1, 0, 1)
pShape.ShapeNumber = indexShape
pShape.StyleId = idTextStyleShape
acBlkTblRec.AppendEntity(pShape)
nameShape = pShape.Name
pShape.Erase()
End If
FuncReturnTypeLineCode = FuncReturnTypeLineCode & "," & l & ",[" & nameShape & "," & textStyleShape.FileName & ",S=" & recTypeLine.ShapeScaleAt(i) & ",R=" & recTypeLine.ShapeRotationAt(i) & ",X=" & recTypeLine.ShapeOffsetAt(i).X & ",Y=" & recTypeLine.ShapeOffsetAt(i).Y & "]"
ElseIf textVal.Trim.Length > 0 Then
Dim id As ObjectId = recTypeLine.ShapeStyleAt(i)
Dim acShape As TextStyleTableRecord = tr.GetObject(id, OpenMode.ForRead)
FuncReturnTypeLineCode = FuncReturnTypeLineCode & "," & l & ",[" & Chr(34) & textVal & Chr(34) & "," & IO.Path.GetFileNameWithoutExtension(acShape.FileName) & ",S=" & recTypeLine.ShapeScaleAt(i) & ",R=" & recTypeLine.ShapeRotationAt(i) & ",X=" & recTypeLine.ShapeOffsetAt(i).X & ",Y=" & recTypeLine.ShapeOffsetAt(i).Y & "]"
Else
FuncReturnTypeLineCode = FuncReturnTypeLineCode & "," & l
End If
Next i
Catch ex As Autodesk.AutoCAD.Runtime.Exception
End Try
End If
End Using
End Function