求助各位高手！

super959

如何用vb打开CAD，然后对多条线进行标注？用高手会吗？谢谢先

雪山飞狐_lzh

2. Private AcadApp As Object
3. Private DocApp As Object
4. Private ModelApp As Object
5. Private Sub Class_Initialize()
6. On Error Resume Next
7. Set AcadApp = GetObject(, "AutoCAD.application")
8. If Err Then
9. Err.Clear
10. Set AcadApp = CreateObject("AutoCAD.application")
11. If Err Then
12. MsgBox Err.Description
13. Exit Sub
14. End If
15. End If
16. AcadApp.Visible = True
17. Set DocApp = AcadApp.activedocument
18. Set ModelApp = DocApp.modelspace
19. End Sub
20. Public Sub 水平标注(ByVal 开始点 As 点类, ByVal 结束点 As 点类, ByVal 标注文字位置 As Double, Optional 标注内容 = " ")
21. Dim cor(2) As Double
22. Dim pnt(2) As Double
23. Dim dot(2) As Double
24. Dim obj As Object
25. pnt(0) = 开始点.X_坐标
26. pnt(1) = 开始点.Y_坐标
27. dot(0) = 结束点.X_坐标
28. dot(1) = 结束点.Y_坐标
29. cor(0) = (开始点.X_坐标 + 结束点.X_坐标) / 2
30. cor(1) = 标注文字位置
31. Set obj = ModelApp.addDimrotated(pnt, dot, cor, 0)
32. obj.layer = "标注线"
33. If 标注内容 <> " " Then obj.TextString = 标注内容
34. If 标注内容 = "NULL" Then obj.TextString = " "
35. obj.Update
36. End Sub
37. Public Sub 垂直标注(ByVal 开始点 As 点类, ByVal 结束点 As 点类, ByVal 标注文字位置 As Double, Optional 标注内容 = " ")
38. Dim obj As Object
39. Dim pnt(2) As Double
40. Dim dot(2) As Double
41. Dim cor(2) As Double
42. pnt(0) = 开始点.X_坐标
43. pnt(1) = 开始点.Y_坐标
44. pnt(2) = 0
45. dot(0) = 结束点.X_坐标
46. dot(1) = 结束点.Y_坐标
47. dot(2) = 0
48. cor(0) = 标注文字位置
49. cor(1) = (开始点.Y_坐标 + 结束点.Y_坐标) / 2
50. cor(2) = 0
51. Set obj = ModelApp.addDimrotated(pnt, dot, cor, 1.57)
52. obj.layer = "标注线"
53. If 标注内容 <> " " Then obj.TextString = 标注内容
54. If 标注内容 = "NULL" Then obj.TextString = " "
55. obj.Update
56. End Sub

Private AcadApp As Object Private DocApp As Object Private ModelApp As Object Private Sub Class_Initialize() On Error Resume Next Set AcadApp = GetObject(, "AutoCAD.application") If Err Then Err.Clear Set AcadApp = CreateObject("AutoCAD.application") If Err Then MsgBox Err.Description Exit Sub End If End If AcadApp.Visible = True Set DocApp = AcadApp.activedocument Set ModelApp = DocApp.modelspace End Sub Public Sub 水平标注(ByVal 开始点 As 点类, ByVal 结束点 As 点类, ByVal 标注文字位置 As Double, Optional 标注内容 = " ") Dim cor(2) As Double Dim pnt(2) As Double Dim dot(2) As Double Dim obj As Object pnt(0) = 开始点.X_坐标 pnt(1) = 开始点.Y_坐标 dot(0) = 结束点.X_坐标 dot(1) = 结束点.Y_坐标 cor(0) = (开始点.X_坐标 + 结束点.X_坐标) / 2 cor(1) = 标注文字位置 Set obj = ModelApp.addDimrotated(pnt, dot, cor, 0) obj.layer = "标注线" If 标注内容 <> " " Then obj.TextString = 标注内容 If 标注内容 = "NULL" Then obj.TextString = " " obj.Update End Sub Public Sub 垂直标注(ByVal 开始点 As 点类, ByVal 结束点 As 点类, ByVal 标注文字位置 As Double, Optional 标注内容 = " ") Dim obj As Object Dim pnt(2) As Double Dim dot(2) As Double Dim cor(2) As Double pnt(0) = 开始点.X_坐标 pnt(1) = 开始点.Y_坐标 pnt(2) = 0 dot(0) = 结束点.X_坐标 dot(1) = 结束点.Y_坐标 dot(2) = 0 cor(0) = 标注文字位置 cor(1) = (开始点.Y_坐标 + 结束点.Y_坐标) / 2 cor(2) = 0 Set obj = ModelApp.addDimrotated(pnt, dot, cor, 1.57) obj.layer = "标注线" If 标注内容 <> " " Then obj.TextString = 标注内容 If 标注内容 = "NULL" Then obj.TextString = " " obj.Update End Sub

几年前编的，R14下调用，现在看起来很搞笑

super959

谢谢，我这就是试一试。

super959

高手，上面我没说明白。我的想法是用鼠标同时选中多条线，然后回到vb界面中输入标注的内容，点击“确定”后，CAD中被选中的多条线的标注内容出现。


问题：1. 如何选中多条线？


                                                                                 2. 标注的样式和方向的确定？


        谢谢大侠了

雪山飞狐_lzh

1、用选择集做，具体用法可以搜索以前的帖子或看看帮助 2、Set obj = ModelApp.addDimrotated(pnt, dot, cor, 1.57)
cor是标注点的位置 obj .StyleName指定样式

super959

十分感谢


我是新手以后请多多指教。