乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 65|回复: 4

如何让用户指定的线条放在其他图形之上?

[复制链接]

15

主题

53

帖子

2

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
113
发表于 2008-3-21 22:52:00 | 显示全部楼层 |阅读模式
大家知道画图的时候后画的线会放在其他图形之上,而如果先画线再放置图形则图形会吧线遮住,请问如何能够把这些遮住的线放到其他图形之上。
回复

使用道具 举报

9

主题

33

帖子

2

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
69
发表于 2008-3-22 11:33:00 | 显示全部楼层
待性里面调整线的高度
回复

使用道具 举报

15

主题

53

帖子

2

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
113
发表于 2008-3-22 22:37:00 | 显示全部楼层
什么意思啊,我现在是在二维的环境下,哪来高度啊!
回复

使用道具 举报

72

主题

2726

帖子

9

银币

社区元老

Rank: 75Rank: 75Rank: 75

铜币
3014
发表于 2008-3-23 11:21:00 | 显示全部楼层
  1. Sub Example_SortentsTable()
  2.     ' This example creates a SortentsTable object and
  3.     ' changes the draw order.    ' Set drawing to display lineweights and create a True Color object
  4.     Dim ACADPref As AcadDatabasePreferences
  5.     Set ACADPref = ThisDrawing.Preferences
  6.     ACADPref.LineWeightDisplay = True
  7.     Dim MyColorObjOne As AcadAcCmColor
  8.     Set MyColorObjOne = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")
  9.     Call MyColorObjOne.SetRGB(80, 100, 244)
  10.    
  11.     ' Draw a polyline
  12.     Dim plineObj As AcadPolyline
  13.     Dim points(0 To 8) As Double
  14.     points(0) = 4: points(1) = 4: points(2) = 0
  15.     points(3) = 3: points(4) = 5: points(5) = 0
  16.     points(6) = 6: points(7) = 20: points(8) = 0
  17.     Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points)
  18.     plineObj.Lineweight = acLnWt211
  19.     Call MyColorObjOne.SetRGB(90, 110, 150)
  20.     plineObj.TrueColor = MyColorObjOne    ' Draw a line
  21.     Dim lineObj As AcadLine
  22.     Dim startPoint(0 To 2) As Double
  23.     Dim endPoint(0 To 2) As Double
  24.     startPoint(0) = 5: startPoint(1) = 13: startPoint(2) = 0
  25.     endPoint(0) = 5: endPoint(1) = 27: endPoint(2) = 0
  26.     Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
  27.     lineObj.Lineweight = acLnWt211
  28.     Call MyColorObjOne.SetRGB(50, 80, 230)
  29.     lineObj.TrueColor = MyColorObjOne
  30.      
  31.     ' Draw a circle
  32.     Dim circleObj As AcadCircle
  33.     Dim centerPoint(0 To 2) As Double
  34.     Dim radius As Double
  35.     centerPoint(0) = 10: centerPoint(1) = 15: centerPoint(2) = 0#
  36.     radius = 5#
  37.     Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPoint, radius)
  38.     circleObj.Lineweight = acLnWt211
  39.     Call MyColorObjOne.SetRGB(60, 200, 220)
  40.     circleObj.TrueColor = MyColorObjOne
  41.     ZoomAll
  42.     AcadApplication.Update
  43.       
  44.     'Gxet an extension dictionary and, if necessary, add a SortentsTable object
  45.     Dim eDictionary As Object
  46.     Set eDictionary = ThisDrawing.ModelSpace.GetExtensionDictionary
  47.     ' Prevent failed GetObject calls from throwing an exception
  48.     On Error Resume Next
  49.     Dim sentityObj As Object
  50.     Set sentityObj = eDictionary.GetObject("ACAD_SORTENTS")
  51.     On Error GoTo 0
  52.     If sentityObj Is Nothing Then
  53.          ' No SortentsTable object, so add one
  54.          Set sentityObj = eDictionary.AddObject("ACAD_SORTENTS", "AcDbSortentsTable")
  55.     End If
  56.    
  57.     Dim ObjIds(2) As Long
  58.     ObjIds(0) = plineObj.ObjectID
  59.     ObjIds(1) = lineObj.ObjectID
  60.     ObjIds(2) = circleObj.ObjectID
  61.    
  62.     Dim varObject As AcadObject
  63.     Set varObject = ThisDrawing.ObjectIdToObject(ObjIds(2))
  64.     Dim arr(0) As AcadObject
  65.     Set arr(0) = varObject
  66.    
  67.     'Move the circle object to the bottom
  68.     sentityObj.MoveToBottom arr
  69.     AcadApplication.Update
  70.          
  71. End Sub
回复

使用道具 举报

15

主题

53

帖子

2

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
113
发表于 2008-3-25 20:57:00 | 显示全部楼层
谢谢版主了,版主真是有问必答啊!
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-7-5 03:33 , Processed in 1.060544 second(s), 63 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表