如何让用户指定的线条放在其他图形之上？
<p>大家知道画图的时候后画的线会放在其他图形之上，而如果先画线再放置图形则图形会吧线遮住，请问如何能够把这些遮住的线放到其他图形之上。</p> <p>待性里面调整线的高度</p> 什么意思啊，我现在是在二维的环境下，哪来高度啊！ Sub Example_SortentsTable()' This example creates a SortentsTable object and
' changes the draw order. ' Set drawing to display lineweights and create a True Color object
Dim ACADPref As AcadDatabasePreferences
Set ACADPref = ThisDrawing.Preferences
ACADPref.LineWeightDisplay = True
Dim MyColorObjOne As AcadAcCmColor
Set MyColorObjOne = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")
Call MyColorObjOne.SetRGB(80, 100, 244)
' Draw a polyline
Dim plineObj As AcadPolyline
Dim points(0 To 8) As Double
points(0) = 4: points(1) = 4: points(2) = 0
points(3) = 3: points(4) = 5: points(5) = 0
points(6) = 6: points(7) = 20: points(8) = 0
Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points)
plineObj.Lineweight = acLnWt211
Call MyColorObjOne.SetRGB(90, 110, 150)
plineObj.TrueColor = MyColorObjOne ' Draw a line
Dim lineObj As AcadLine
Dim startPoint(0 To 2) As Double
Dim endPoint(0 To 2) As Double
startPoint(0) = 5: startPoint(1) = 13: startPoint(2) = 0
endPoint(0) = 5: endPoint(1) = 27: endPoint(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
lineObj.Lineweight = acLnWt211
Call MyColorObjOne.SetRGB(50, 80, 230)
lineObj.TrueColor = MyColorObjOne
' Draw a circle
Dim circleObj As AcadCircle
Dim centerPoint(0 To 2) As Double
Dim radius As Double
centerPoint(0) = 10: centerPoint(1) = 15: centerPoint(2) = 0#
radius = 5#
Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPoint, radius)
circleObj.Lineweight = acLnWt211
Call MyColorObjOne.SetRGB(60, 200, 220)
circleObj.TrueColor = MyColorObjOne
ZoomAll
AcadApplication.Update
'Gxet an extension dictionary and, if necessary, add a SortentsTable object
Dim eDictionary As Object
Set eDictionary = ThisDrawing.ModelSpace.GetExtensionDictionary
' Prevent failed GetObject calls from throwing an exception
On Error Resume Next
Dim sentityObj As Object
Set sentityObj = eDictionary.GetObject("ACAD_SORTENTS")
On Error GoTo 0
If sentityObj Is Nothing Then
' No SortentsTable object, so add one
Set sentityObj = eDictionary.AddObject("ACAD_SORTENTS", "AcDbSortentsTable")
End If
Dim ObjIds(2) As Long
ObjIds(0) = plineObj.ObjectID
ObjIds(1) = lineObj.ObjectID
ObjIds(2) = circleObj.ObjectID
Dim varObject As AcadObject
Set varObject = ThisDrawing.ObjectIdToObject(ObjIds(2))
Dim arr(0) As AcadObject
Set arr(0) = varObject
'Move the circle object to the bottom
sentityObj.MoveToBottom arr
AcadApplication.Update
End Sub 谢谢版主了，版主真是有问必答啊！
页:
[1]