等高线该颜色.txt

等高线该颜色.txt 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