乐筑天下

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

[编程交流] 生成文本对象时出错

[复制链接]

14

主题

42

帖子

28

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
70
发表于 2022-7-6 22:28:50 | 显示全部楼层 |阅读模式
大家好!
 
这里的天气不太好,所以又是节目时间了。你能帮我摆脱这个吗?它应该标记块的高度,但当我试图将文本放在块的插入点上时,我会被卡住。我猜不太复杂。我猜错了。。。
 
错误状态为:“对象‘IAcadModelSpace’的方法‘Add3DMesh’失败。”
 
  1. Sub BlockHeight()
  2. Dim aEnt As AcadEntity
  3. Dim aBlock As AcadBlockReference
  4. Dim aText As AcadText
  5. Dim sText As String
  6. Dim NewLayer As AcadLayer
  7. Dim retValue As Variant
  8. Dim retCoord(0 To 2) As Double
  9. Dim attrib As Variant
  10. Dim sset As AcadSelectionSet
  11. Dim FilterType(0) As Integer
  12. Dim FilterData(0) As Variant
  13. Dim InsertionPoint As Variant
  14. FilterType(0) = 8
  15. FilterData(0) = "OCT_KDT"
  16. On error GoTo Delete
  17. Set sset = ThisDrawing.SelectionSets.Add("sset")
  18. sset.Select acSelectionSetAll, , , FilterType, FilterData
  19. On error goto Errorhandling
  20. For Each aEnt In sset
  21.    If TypeOf aEnt Is AcadBlockReference Then
  22.        Set aBlock = aEnt
  23.        retValue = aBlock.GetAttributes
  24.        For Each attrib In retValue
  25.            If attrib.TagString = "LAYER" Then
  26.                sText = attrib.TextString
  27.            End If
  28.        Next attrib
  29.        If sText Like "N_WRI*" Then
  30.            Set NewLayer = ThisDrawing.Layers.Add("N_LOW")
  31.            sText = aBlock.InsertionPoint(2)
  32.            InsertionPoint = aBlock.InsertionPoint
  33.            Set aText = ThisDrawing.ModelSpace.AddText(sText, InsertionPoint, 0)
  34.            aText.Layer = "N_LOW"
  35.            aText.StyleName = "OCTOPUS"
  36.            aText.Height = 0.5
  37.            aText.Rotation = 0
  38.            NewLayer.Color = acYellow
  39.        End If
  40.    End If
  41. Next aEnt
  42. sset.Delete
  43. Exit Sub
  44. Delete:
  45. ThisDrawing.SelectionSets.Item("sset").Delete
  46. Resume
  47. Errorhandling:
  48. ThisDrawing.SelectionSets.Item("sset").Delete
  49. End Sub
回复

使用道具 举报

发表回复

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

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-2-28 14:44 , Processed in 0.339481 second(s), 54 queries .

© 2020-2025 乐筑天下

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