Message 1 of 7

Not applicable
04-01-2012
10:19 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
here my code :
Public Function LectureDefLine() As Collection Dim db As Database = New Database(True, False) Dim OkErreur As Boolean = False dim cCollDefTypeLine as collection = New Collection Try Dim path As String = HostApplicationServices.Current.FindFile("acad.lin", db, FindFileHint.Default) db.LoadLineTypeFile("*", path) Catch ex As Autodesk.AutoCAD.Runtime.Exception If (ex.ErrorStatus = Autodesk.AutoCAD.Runtime.ErrorStatus.FilerError) Then MsgBox("Impossible de trouver le fichier " & "acad.lin", MsgBoxStyle.Information, "Erreur système") OkErreur = True ElseIf (ex.ErrorStatus = Autodesk.AutoCAD.Runtime.ErrorStatus.DuplicateRecordName) Then 'Ligne déja connu --> passe Else MsgBox(ex.ToString, MsgBoxStyle.Information, "Erreur système") OkErreur = True End If End Try If OkErreur = False Then 'iterate les typeline Dim tr As Transaction = db.TransactionManager.StartTransaction() Try Dim TypelineT As DBObject = tr.GetObject(db.LinetypeTableId, OpenMode.ForRead) Dim tbl As SymbolTable = CType(TypelineT, SymbolTable) If IsNothing(tbl) = False Then Dim tblRecId As ObjectId For Each tblRecId In tbl Dim tmpObj1 As DBObject = tr.GetObject(tblRecId, OpenMode.ForRead) Dim rec As SymbolTableRecord = CType(tmpObj1, LinetypeTableRecord) If Not (rec Is Nothing) Then cCollDefTypeLine.Add(rec.Name, rec.Name) 'ed.WriteMessage("Adding LineType " & rec.Name & vbCrLf) End If Next End If Catch ex As Exception MsgBox(ex.ToString, MsgBoxStyle.Information, "err") Finally tr.Commit() tr.Dispose() End Try End If db.Dispose() db = Nothing Return cCollDefTypeLine End Function
cCollDefTypeLine : i use it for populate a ComboxColumn of a dataview.
I want populate a ColumnDataview but not integrate all the linetype in mu current dwg.
This code run but acad crash after .. So have you a function/sub working fine ?
Thx All
Solved! Go to Solution.