大家一起完善一个粗糙度标注的程序

mccad

刚写完了一个函数，在想是用属性块用呢还是用匿名块好呢。
因为写的时候用了匿名块，写完了了现没有必须用匿名块，好象属性块好，建立四个图块(也用程序生成)，在生成时先查看是否有该名称图块存在，如果存在则直接引用，如果不存在则引用新建块函数新建一个相应的属性块。

现在把已经写好的部分贴出来。是用匿名块方法，而且也只写了一部分，还没有写到交互操作部分。

2. Sub AddCCD()
   
3. Dim pnt As Variant
   
4. pnt = ThisDrawing.Utility.GetPoint(, "插入点:")
   
5. CreateCCD 0, pnt, Radians(150), 3.5, 1
   
6. End Sub
   
7. 
   
8. ' 粗糙度符号标注函数
   
9. ' Mode为粗糙度模式，0代表表面未加工，1代表表面加工
   
10. ' InsertPoint为插入点位置
    
11. ' Angle为插入的角度
    
12. ' Value粗糙度值
    
13. ' Factor为插入的比例因子
    
14. Function CreateCCD(Mode As Integer, InsertPoint As Variant, Angle As Double, Value As String, Factor As Double) As AcadBlockReference
    
15.     Dim objBlock As AcadBlock
    
16.     Dim InsPnt(2) As Double
    
17.     InsPnt(0) = 0: InsPnt(1) = 0: InsPnt(2) = 0
    
18.     Set objBlock = ThisDrawing.Blocks.Add(InsPnt, "*U")
    
19.     Dim Pnt2 As Variant
    
20.     Dim Pnt3 As Variant
    
21.     Dim Pnt4 As Variant
    
22.     Dim Pnt5 As Variant
    
23.     Dim Pnt6 As Variant
    
24.     Dim Pnt7 As Variant
    
25.     Dim r As Variant
    
26.     Pnt2 = ThisDrawing.Utility.PolarPoint(InsPnt, Radians(60), 12)
    
27.     Pnt3 = ThisDrawing.Utility.PolarPoint(InsPnt, Radians(120), 6)
    
28.     Pnt4 = ThisDrawing.Utility.PolarPoint(Pnt3, 0, 6)
    
29.     Pnt5 = ThisDrawing.Utility.PolarPoint(InsPnt, Radians(90), 3 / Cos(Radians(30)))
    
30.     Pnt6 = ThisDrawing.Utility.PolarPoint(Pnt4, Radians(90), 0.7)
    
31.     Pnt7 = ThisDrawing.Utility.PolarPoint(Pnt4, Radians(90), 4.2)
    
32.     r = 3 * Tan(Radians(30))
    
33.     Dim objLine As AcadLine
    
34.     Dim objCircle As AcadCircle
    
35.     Set objLine = objBlock.AddLine(InsPnt, Pnt2)
    
36.     objLine.color = acByBlock
    
37.     Set objLine = objBlock.AddLine(InsPnt, Pnt3)
    
38.     objLine.color = acByBlock
    
39.     If Mode = 1 Then
    
40.         Set objLine = objBlock.AddLine(Pnt3, Pnt4)
    
41.         objLine.color = acByBlock
    
42.     ElseIf Mode = 0 Then
    
43.         Set objCircle = objBlock.AddCircle(Pnt5, r)
    
44.         objCircle.color = acByBlock
    
45.     End If
    
46.     Dim objText As AcadText
    
47.     If Angle > Radians(90) And Angle <= Radians(270) Then
    
48.         Set objText = objBlock.AddText(Value, Pnt6, 3.5)
    
49.         objText.Alignment = acAlignmentTopLeft
    
50.         objText.Rotate InsPnt, Radians(180)
    
51.         objText.Move InsPnt, Pnt6
    
52.     Else
    
53.         Set objText = objBlock.AddText(Value, Pnt6, 3.5)
    
54.         objText.Alignment = acAlignmentBottomRight
    
55.         objText.Move InsPnt, Pnt6
    
56.     End If
    
57.     objText.color = acByBlock
    
58.     Dim blkname As String
    
59.     blkname = objBlock.Name
    
60.     Dim objBlockRef As AcadBlockReference
    
61.     Set objBlockRef = ThisDrawing.ModelSpace.InsertBlock(InsertPoint, blkname, Factor, Factor, Factor, Angle)
    
62.     Set CreateCCD = objBlockRef
    
63. End Function
    
64. 
    
65. Public Function PI() As Double
    
66.   PI = Atn(1) * 4
    
67. End Function
    
68. 
    
69. Private Function Degrees(Radians As Double) As Double
    
70.   Degrees = Radians / PI * 180
    
71. End Function
    
72. 
    
73. Private Function Radians(Degrees As Double) As Double
    
74.   Radians = Degrees / 180 * PI
    
75. End Function
    

Sub AddCCD()<br /> Dim pnt As Variant<br /> pnt = ThisDrawing.Utility.GetPoint(, "插入点:")<br /> CreateCCD 0, pnt, Radians(150), 3.5, 1<br /> End Sub<br /> <br /> ' 粗糙度符号标注函数<br /> ' Mode为粗糙度模式，0代表表面未加工，1代表表面加工<br /> ' InsertPoint为插入点位置<br /> ' Angle为插入的角度<br /> ' Value粗糙度值<br /> ' Factor为插入的比例因子<br /> Function CreateCCD(Mode As Integer, InsertPoint As Variant, Angle As Double, Value As String, Factor As Double) As AcadBlockReference<br />     Dim objBlock As AcadBlock<br />     Dim InsPnt(2) As Double<br />     InsPnt(0) = 0: InsPnt(1) = 0: InsPnt(2) = 0<br />     Set objBlock = ThisDrawing.Blocks.Add(InsPnt, "*U")<br />     Dim Pnt2 As Variant<br />     Dim Pnt3 As Variant<br />     Dim Pnt4 As Variant<br />     Dim Pnt5 As Variant<br />     Dim Pnt6 As Variant<br />     Dim Pnt7 As Variant<br />     Dim r As Variant<br />     Pnt2 = ThisDrawing.Utility.PolarPoint(InsPnt, Radians(60), 12)<br />     Pnt3 = ThisDrawing.Utility.PolarPoint(InsPnt, Radians(120), 6)<br />     Pnt4 = ThisDrawing.Utility.PolarPoint(Pnt3, 0, 6)<br />     Pnt5 = ThisDrawing.Utility.PolarPoint(InsPnt, Radians(90), 3 / Cos(Radians(30)))<br />     Pnt6 = ThisDrawing.Utility.PolarPoint(Pnt4, Radians(90), 0.7)<br />     Pnt7 = ThisDrawing.Utility.PolarPoint(Pnt4, Radians(90), 4.2)<br />     r = 3 * Tan(Radians(30))<br />     Dim objLine As AcadLine<br />     Dim objCircle As AcadCircle<br />     Set objLine = objBlock.AddLine(InsPnt, Pnt2)<br />     objLine.color = acByBlock<br />     Set objLine = objBlock.AddLine(InsPnt, Pnt3)<br />     objLine.color = acByBlock<br />     If Mode = 1 Then<br />         Set objLine = objBlock.AddLine(Pnt3, Pnt4)<br />         objLine.color = acByBlock<br />     ElseIf Mode = 0 Then<br />         Set objCircle = objBlock.AddCircle(Pnt5, r)<br />         objCircle.color = acByBlock<br />     End If<br />     Dim objText As AcadText<br />     If Angle > Radians(90) And Angle <= Radians(270) Then<br />         Set objText = objBlock.AddText(Value, Pnt6, 3.5)<br />         objText.Alignment = acAlignmentTopLeft<br />         objText.Rotate InsPnt, Radians(180)<br />         objText.Move InsPnt, Pnt6<br />     Else<br />         Set objText = objBlock.AddText(Value, Pnt6, 3.5)<br />         objText.Alignment = acAlignmentBottomRight<br />         objText.Move InsPnt, Pnt6<br />     End If<br />     objText.color = acByBlock<br />     Dim blkname As String<br />     blkname = objBlock.Name<br />     Dim objBlockRef As AcadBlockReference<br />     Set objBlockRef = ThisDrawing.ModelSpace.InsertBlock(InsertPoint, blkname, Factor, Factor, Factor, Angle)<br />     Set CreateCCD = objBlockRef<br /> End Function<br /> <br /> Public Function PI() As Double<br />   PI = Atn(1) * 4<br /> End Function<br /> <br /> Private Function Degrees(Radians As Double) As Double<br />   Degrees = Radians / PI * 180<br /> End Function<br /> <br /> Private Function Radians(Degrees As Double) As Double<br />   Radians = Degrees / 180 * PI<br /> End Function<br />

subtlation

属性块应该更好，直接调用也方便

mccad

改成了使用属性块，程序中包括了属性块的生成方法和属性块插入后的属性修改

以下为简单的程序调用部分，大家可以继续完善
Sub ic()
On Error Resume Next
Dim pnt As Variant
pnt = ThisDrawing.Utility.GetPoint(, " 选择插入点：")
Dim angle As Double
angle = ThisDrawing.Utility.GetAngle(pnt, " 选择选择角度：")
Dim txt As String
txt = ThisDrawing.Utility.GetString(0, " 请输入粗糙度大小：")
Dim mode As Integer
mode = ThisDrawing.Utility.GetInteger(" 选择粗糙度样式[表面非加工0/表面加工1]<表面非加工>：")
If Err Then
    mode = 0
    Err.Clear
End If
CreateCCD mode, pnt, angle, txt, 1
End Sub

以下为生成粗糙度的函数部分：

2. 
   
3. ' 粗糙度符号标注函数
   
4. ' Mode为粗糙度模式，0代表表面未加工，1代表表面加工
   
5. ' InsertPoint为插入点
   
6. ' Angle为插入的角度
   
7. ' Value粗糙度值
   
8. ' Factor为插入的比例因子
   
9. Function CreateCCD(mode As Integer, InsertPoint As Variant, angle As Double, Value As String, Factor As Double) As AcadBlockReference
   
10.     Dim objBlock As AcadBlock
    
11.     Dim InsPnt(2) As Double
    
12.     InsPnt(0) = 0: InsPnt(1) = 0: InsPnt(2) = 0
    
13.     Dim BlkName As String
    
14.     BlkName = "mc_ccd_" & mode
    
15.     On Error Resume Next
    
16.     Set objBlock = ThisDrawing.Blocks(BlkName)
    
17.     If Err Then
    
18.         Err.Clear
    
19.         Set objBlock = ThisDrawing.Blocks.Add(InsPnt, BlkName)
    
20.    
    
21.         Dim Pnt2 As Variant
    
22.         Dim Pnt3 As Variant
    
23.         Dim Pnt4 As Variant
    
24.         Dim Pnt5 As Variant
    
25.         Dim Pnt6 As Variant
    
26.         Dim r As Variant
    
27.         Pnt2 = ThisDrawing.Utility.PolarPoint(InsPnt, Radians(60), 12)
    
28.         Pnt3 = ThisDrawing.Utility.PolarPoint(InsPnt, Radians(120), 6)
    
29.         Pnt4 = ThisDrawing.Utility.PolarPoint(Pnt3, 0, 6)
    
30.         Pnt5 = ThisDrawing.Utility.PolarPoint(InsPnt, Radians(90), 3 / Cos(Radians(30)))
    
31.         Pnt6 = ThisDrawing.Utility.PolarPoint(Pnt4, Radians(90), 0.7)
    
32.         r = 3 * Tan(Radians(30))
    
33.         Dim objLine As AcadLine
    
34.         Dim objCircle As AcadCircle
    
35.         Set objLine = objBlock.AddLine(InsPnt, Pnt2)
    
36.         objLine.color = acByBlock
    
37.         Set objLine = objBlock.AddLine(InsPnt, Pnt3)
    
38.         objLine.color = acByBlock
    
39.         If mode = 1 Then
    
40.             Set objLine = objBlock.AddLine(Pnt3, Pnt4)
    
41.             objLine.color = acByBlock
    
42.         ElseIf mode = 0 Then
    
43.             Set objCircle = objBlock.AddCircle(Pnt5, r)
    
44.             objCircle.color = acByBlock
    
45.         End If
    
46.         Dim objAtt As AcadAttribute
    
47.         Set objAtt = objBlock.AddAttribute(3.5, acAttributeModeNormal, "粗糙度值", Pnt6, "CCD", "")
    
48.         objAtt.Alignment = acAlignmentBottomRight
    
49.         objAtt.Move InsPnt, Pnt6
    
50.         objAtt.color = acByBlock
    
51.     End If
    
52.     Dim objBlockRef As AcadBlockReference
    
53.     Set objBlockRef = ThisDrawing.ModelSpace.InsertBlock(InsertPoint, BlkName, Factor, Factor, Factor, angle)
    
54.     Dim objAtts As Variant
    
55.     objAtts = objBlockRef.GetAttributes
    
56.     Dim objAttRef As AcadAttributeReference
    
57.     Set objAttRef = objAtts(0)
    
58.     objAttRef.TextString = Value
    
59.     If angle > Radians(90) And angle <= Radians(270) Then
    
60.         objAttRef.Alignment = acAlignmentTopLeft
    
61.         objAttRef.Rotate objAttRef.TextAlignmentPoint, Radians(180)
    
62.     End If
    
63. End Function
    
64. 
    
65. Public Function PI() As Double
    
66.   PI = Atn(1) * 4
    
67. End Function
    
68. 
    
69. Private Function Degrees(Radians As Double) As Double
    
70.   Degrees = Radians / PI * 180
    
71. End Function
    
72. 
    
73. Private Function Radians(Degrees As Double) As Double
    
74.   Radians = Degrees / 180 * PI
    
75. End Function
    

<br /> ' 粗糙度符号标注函数<br /> ' Mode为粗糙度模式，0代表表面未加工，1代表表面加工<br /> ' InsertPoint为插入点<br /> ' Angle为插入的角度<br /> ' Value粗糙度值<br /> ' Factor为插入的比例因子<br /> Function CreateCCD(mode As Integer, InsertPoint As Variant, angle As Double, Value As String, Factor As Double) As AcadBlockReference<br />     Dim objBlock As AcadBlock<br />     Dim InsPnt(2) As Double<br />     InsPnt(0) = 0: InsPnt(1) = 0: InsPnt(2) = 0<br />     Dim BlkName As String<br />     BlkName = "mc_ccd_" & mode<br />     On Error Resume Next<br />     Set objBlock = ThisDrawing.Blocks(BlkName)<br />     If Err Then<br />         Err.Clear<br />         Set objBlock = ThisDrawing.Blocks.Add(InsPnt, BlkName)<br />     <br />         Dim Pnt2 As Variant<br />         Dim Pnt3 As Variant<br />         Dim Pnt4 As Variant<br />         Dim Pnt5 As Variant<br />         Dim Pnt6 As Variant<br />         Dim r As Variant<br />         Pnt2 = ThisDrawing.Utility.PolarPoint(InsPnt, Radians(60), 12)<br />         Pnt3 = ThisDrawing.Utility.PolarPoint(InsPnt, Radians(120), 6)<br />         Pnt4 = ThisDrawing.Utility.PolarPoint(Pnt3, 0, 6)<br />         Pnt5 = ThisDrawing.Utility.PolarPoint(InsPnt, Radians(90), 3 / Cos(Radians(30)))<br />         Pnt6 = ThisDrawing.Utility.PolarPoint(Pnt4, Radians(90), 0.7)<br />         r = 3 * Tan(Radians(30))<br />         Dim objLine As AcadLine<br />         Dim objCircle As AcadCircle<br />         Set objLine = objBlock.AddLine(InsPnt, Pnt2)<br />         objLine.color = acByBlock<br />         Set objLine = objBlock.AddLine(InsPnt, Pnt3)<br />         objLine.color = acByBlock<br />         If mode = 1 Then<br />             Set objLine = objBlock.AddLine(Pnt3, Pnt4)<br />             objLine.color = acByBlock<br />         ElseIf mode = 0 Then<br />             Set objCircle = objBlock.AddCircle(Pnt5, r)<br />             objCircle.color = acByBlock<br />         End If<br />         Dim objAtt As AcadAttribute<br />         Set objAtt = objBlock.AddAttribute(3.5, acAttributeModeNormal, "粗糙度值", Pnt6, "CCD", "")<br />         objAtt.Alignment = acAlignmentBottomRight<br />         objAtt.Move InsPnt, Pnt6<br />         objAtt.color = acByBlock<br />     End If<br />     Dim objBlockRef As AcadBlockReference<br />     Set objBlockRef = ThisDrawing.ModelSpace.InsertBlock(InsertPoint, BlkName, Factor, Factor, Factor, angle)<br />     Dim objAtts As Variant<br />     objAtts = objBlockRef.GetAttributes<br />     Dim objAttRef As AcadAttributeReference<br />     Set objAttRef = objAtts(0)<br />     objAttRef.TextString = Value<br />     If angle > Radians(90) And angle <= Radians(270) Then<br />         objAttRef.Alignment = acAlignmentTopLeft<br />         objAttRef.Rotate objAttRef.TextAlignmentPoint, Radians(180)<br />     End If<br /> End Function<br /> <br /> Public Function PI() As Double<br />   PI = Atn(1) * 4<br /> End Function<br /> <br /> Private Function Degrees(Radians As Double) As Double<br />   Degrees = Radians / PI * 180<br /> End Function<br /> <br /> Private Function Radians(Degrees As Double) As Double<br />   Radians = Degrees / 180 * PI<br /> End Function<br />

断桥

呵呵，有些难度，看着累死俺村人了：）

zjxzdb21

楼主好啊，我还是看的不是很懂

McCAD是什么意思啊？

我做的毕业设计是用VB实现粗糙度的快速标注，你说的这些事不是对我的很有用处啊？