乐筑天下

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

替代acad中的文本

[复制链接]

2

主题

3

帖子

1

银币

初来乍到

Rank: 1

铜币
11
发表于 2005-12-9 05:48:49 | 显示全部楼层 |阅读模式
你好,另一个问题。Vba使用此代码在acad中绘制一条线,并在其后添加尺寸。我想覆盖文本并将SH =放在它的前面。这些都可以,但是在下一行的维度中,我想把SD =放在它前面。我如何在下面“校准尺寸”行中输入文本覆盖?可能吗?这将使我的代码小很多
子维度(x1,y1,x2,y2,x3,y3)
Dim Dim object As AcadDimAligned
Dim startpnt(0到2) As Double
Dim endpnt(0到2)As Double
Dim text position(0到2)As Double
startpnt(0)= x1
startpnt(1)= y1
startpnt(2)= 0
endpnt(0)= x2model space . AddDimAligned(start pnt,endpnt,text position)
dimension object。TextOverride = " SH =  " '
我想更改SH
dimensionObject。arrow head size = 180
dimension object。text height = 180 dimension object。extension line Offset = Offset
dimension object。color = acCyan
dimension object。更新
End Sub
' line input
Sub line(x1,y1,x2,y2)
Dim startpnt(0到2) As Double
Dim endpnt(0到2)As Double
Dim line Object As Object
start pnt(0)= x1
start pnt(1)= y1
start pnt(2)= 0
End pnt(0)= x2
End pnt(1)= y2
End pnt(2)=。ModelSpace.AddLine(startpnt,endpnt)
lineObject。更新
End Sub
Sub test()
' draw Line
Call Line(5000,8000,5000,3000)
' draw a dimension
Call dimension(5000,8000,5000,3000,4900,7900)
In here

End Sub
thx

本帖以下内容被隐藏保护;需要你回复后,才能看到!

游客,如果您要查看本帖隐藏内容请回复
回复

使用道具 举报

2

主题

3

帖子

1

银币

初来乍到

Rank: 1

铜币
11
发表于 2005-12-9 06:28:06 | 显示全部楼层

喜欢这个?
  1. Option Explicit
  2. Const DEFAULT_OFFSET = 7
  3. Sub dimension(x1 As Long, y1 As Long, x2 As Long, y2 As Long, x3 As Long, y3 As Long, Optional OffsetDistance As Long, Optional OverideText As String, Optional Offset, Optional DimColor)
  4. Dim dimensionObject As AcadDimAligned
  5. Dim EndPnt(0 To 2) As Double
  6. Dim StartPnt(0 To 2) As Double
  7. Dim TextPosition(0 To 2) As Double
  8. If IsMissing(OverideText) Then OverideText = ""
  9. If IsMissing(Offset) Then Offset = DEFAULT_OFFSET
  10. If IsMissing(DimColor) Then DimColor = acByBlock
  11. StartPnt(0) = x1
  12. StartPnt(1) = y1
  13. StartPnt(2) = 0
  14. EndPnt(0) = x2
  15. EndPnt(1) = y2
  16. EndPnt(2) = 0
  17. TextPosition(0) = x3
  18. TextPosition(1) = y3
  19. TextPosition(2) = 0
  20. Set dimensionObject = ThisDrawing.ModelSpace.AddDimAligned(StartPnt, EndPnt, TextPosition)
  21. dimensionObject.TextOverride = OverideText
  22. dimensionObject.ArrowheadSize = 180
  23. dimensionObject.TextHeight = 180
  24. dimensionObject.ExtensionLineOffset = Offset
  25. dimensionObject.Color = DimColor
  26. dimensionObject.Update
  27. End Sub
  28. Sub line(x1 As Long, y1 As Long, x2 As Long, y2 As Long)
  29. Dim StartPnt(0 To 2) As Double
  30. Dim EndPnt(0 To 2) As Double
  31. Dim lineObject As Object
  32. StartPnt(0) = x1
  33. StartPnt(1) = y1
  34. StartPnt(2) = 0
  35. EndPnt(0) = x2
  36. EndPnt(1) = y2
  37. EndPnt(2) = 0
  38. Set lineObject = ThisDrawing.ModelSpace.AddLine(StartPnt, EndPnt)
  39. lineObject.Update
  40. End Sub
  41. Sub test()
  42. 'draw Line
  43. Call line(-5000, -8000, 5000, 3000)
  44. ' draw a dimension
  45. Call dimension(-5000, -8000, 5000, 3000, 4900, 7900, , "Test")
  46. End Sub

提示 除非您有原因不1原因,否则声明您的参数类型
可以有一个可选参数(如示例中所示),因为类型定义将导致这些参数的默认值赋值。
如果决定省略这些可选参数的类型,请确保在子/函数中实现严肃的类型验证
回复

使用道具 举报

6

主题

94

帖子

1

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
118
发表于 2005-12-9 08:58:27 | 显示全部楼层
谢谢你,Dnereb
你帮了我很多忙
回复

使用道具 举报

发表回复

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

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-7-5 00:53 , Processed in 0.912473 second(s), 58 queries .

© 2020-2025 乐筑天下

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