等高线该颜色
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
Dim ent As Entity
Dim k As Integer
Dim Doc As Document = Application.DocumentManager.MdiActiveDocument
Using LckDoc As DocumentLock = Doc.LockDocument
Using Trans As Transaction = db.TransactionManager.StartTransaction
Try
'建立DIM图层
Dim Lt As LayerTable = Trans.GetObject(db.LayerTableId, OpenMode.ForRead)
Dim Layname As String = "DIM"
If Lt.Has(Layname) = False Then
Dim Ltr As LayerTableRecord = New LayerTableRecord()
Ltr.Name = Layname
Ltr.Color = Color.FromColorIndex(ColorMethod.ByAci, 3)
Lt.UpgradeOpen() '升级图层块表为写入
Lt.Add(Ltr) '加入到图层块表
Trans.AddNewlyCreatedDBObject(Ltr, True) '加入该事务
End If
Dim Bt As BlockTable = Trans.GetObject(db.BlockTableId, OpenMode.ForRead)
Dim Btr As BlockTableRecord = Trans.GetObject(Bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
Dim Tv(1) As TypedValue
Tv.SetValue(New TypedValue(DxfCode.Start, "*PolyLine"), 0)
Tv.SetValue(New TypedValue(DxfCode.LayerName, "计曲线"), 1)
Dim Setfilt As SelectionFilter = New SelectionFilter(Tv)
Dim Result As PromptSelectionResult = ed.GetSelection(Setfilt)
Dim Min, Max As Double
Min = 100000
Max = -1
Dim A1, B1, C1, A2, B2, C2, A3, B3, C3 As Integer
A1 = 0 : B1 = 0 : C1 = 255
A2 = 255 : B2 = 0 : C2 = 0
Dim Pl2(Result.Value.Count - 1) As Polyline
If Result.Status = PromptStatus.OK Then
Dim sset1 As SelectionSet = Result.Value
k = 0
For Each elem As SelectedObject In sset1
ent = Trans.GetObject(elem.ObjectId, OpenMode.ForWrite, False)
If TypeOf ent Is Polyline Then
Dim pl As Polyline = CType(ent, Polyline)
Pl2(k) = pl
Max = Math.Max(pl.Elevation, Max)
Min = Math.Min(pl.Elevation, Min)
k = k + 1
End If
Next
Dim i As Integer
For i = LBound(Pl2) To UBound(Pl2)
A3 = A1 + Int((A2 - A1) * (Pl2(i).Elevation - Min) / (Max
- Min))
B3 = B1 + Int((B2 - B1) * (Pl2(i).Elevation - Min) / (Max - Min))
C3 = C1 + Int((C2 - C1) * (Pl2(i).Elevation - Min) / (Max - Min))
Pl2(i).Color = Color.FromRgb(A3, B3, C3)
Next
End If
Trans.Commit()
Catch ex As Exception
MsgBox("Error " + ex.Message)
End Try
End Using
End Using