|
|
刚写完了一个函数，在想是用属性块用呢还是用匿名块好呢。
因为写的时候用了匿名块，写完了了现没有必须用匿名块，好象属性块好，建立四个图块(也用程序生成)，在生成时先查看是否有该名称图块存在，如果存在则直接引用，如果不存在则引用新建块函数新建一个相应的属性块。
现在把已经写好的部分贴出来。是用匿名块方法，而且也只写了一部分，还没有写到交互操作部分。
[code]
Sub AddCCD()
Dim pnt As Variant
pnt = ThisDrawing.Utility.GetPoint(, "插入点:")
CreateCCD 0, pnt, Radians(150), 3.5, 1
End Sub
' 粗糙度符号标注函数
' Mode为粗糙度模式，0代表表面未加工，1代表表面加工
' InsertPoint为插入点位置
' Angle为插入的角度
' Value粗糙度值
' Factor为插入的比例因子
Function CreateCCD(Mode As Integer, InsertPoint As Variant, Angle As Double, Value As String, Factor As Double) As AcadBlockReference
Dim objBlock As AcadBlock
Dim InsPnt(2) As Double
InsPnt(0) = 0: InsPnt(1) = 0: InsPnt(2) = 0
Set objBlock = ThisDrawing.Blocks.Add(InsPnt, "*U")
Dim Pnt2 As Variant
Dim Pnt3 As Variant
Dim Pnt4 As Variant
Dim Pnt5 As Variant
Dim Pnt6 As Variant
Dim Pnt7 As Variant
Dim r As Variant
Pnt2 = ThisDrawing.Utility.PolarPoint(InsPnt, Radians(60), 12)
Pnt3 = ThisDrawing.Utility.PolarPoint(InsPnt, Radians(120), 6)
Pnt4 = ThisDrawing.Utility.PolarPoint(Pnt3, 0, 6)
Pnt5 = ThisDrawing.Utility.PolarPoint(InsPnt, Radians(90), 3 / Cos(Radians(30)))
Pnt6 = ThisDrawing.Utility.PolarPoint(Pnt4, Radians(90), 0.7)
Pnt7 = ThisDrawing.Utility.PolarPoint(Pnt4, Radians(90), 4.2)
r = 3 * Tan(Radians(30))
Dim objLine As AcadLine
Dim objCircle As AcadCircle
Set objLine = objBlock.AddLine(InsPnt, Pnt2)
objLine.color = acByBlock
Set objLine = objBlock.AddLine(InsPnt, Pnt3)
objLine.color = acByBlock
If Mode = 1 Then
Set objLine = objBlock.AddLine(Pnt3, Pnt4)
objLine.color = acByBlock
ElseIf Mode = 0 Then
Set objCircle = objBlock.AddCircle(Pnt5, r)
objCircle.color = acByBlock
End If
Dim objText As AcadText
If Angle > Radians(90) And Angle ：")
If Err Then
mode = 0
Err.Clear
End If
CreateCCD mode, pnt, angle, txt, 1
End Sub
以下为生成粗糙度的函数部分：
[code]
' 粗糙度符号标注函数
' Mode为粗糙度模式，0代表表面未加工，1代表表面加工
' InsertPoint为插入点
' Angle为插入的角度
' Value粗糙度值
' Factor为插入的比例因子
Function CreateCCD(mode As Integer, InsertPoint As Variant, angle As Double, Value As String, Factor As Double) As AcadBlockReference
Dim objBlock As AcadBlock
Dim InsPnt(2) As Double
InsPnt(0) = 0: InsPnt(1) = 0: InsPnt(2) = 0
Dim BlkName As String
BlkName = "mc_ccd_" & mode
On Error Resume Next
Set objBlock = ThisDrawing.Blocks(BlkName)
If Err Then
Err.Clear
Set objBlock = ThisDrawing.Blocks.Add(InsPnt, BlkName)
Dim Pnt2 As Variant
Dim Pnt3 As Variant
Dim Pnt4 As Variant
Dim Pnt5 As Variant
Dim Pnt6 As Variant
Dim r As Variant
Pnt2 = ThisDrawing.Utility.PolarPoint(InsPnt, Radians(60), 12)
Pnt3 = ThisDrawing.Utility.PolarPoint(InsPnt, Radians(120), 6)
Pnt4 = ThisDrawing.Utility.PolarPoint(Pnt3, 0, 6)
Pnt5 = ThisDrawing.Utility.PolarPoint(InsPnt, Radians(90), 3 / Cos(Radians(30)))
Pnt6 = ThisDrawing.Utility.PolarPoint(Pnt4, Radians(90), 0.7)
r = 3 * Tan(Radians(30))
Dim objLine As AcadLine
Dim objCircle As AcadCircle
Set objLine = objBlock.AddLine(InsPnt, Pnt2)
objLine.color = acByBlock
Set objLine = objBlock.AddLine(InsPnt, Pnt3)
objLine.color = acByBlock
If mode = 1 Then
Set objLine = objBlock.AddLine(Pnt3, Pnt4)
objLine.color = acByBlock
ElseIf mode = 0 Then
Set objCircle = objBlock.AddCircle(Pnt5, r)
objCircle.color = acByBlock
End If
Dim objAtt As AcadAttribute
Set objAtt = objBlock.AddAttribute(3.5, acAttributeModeNormal, "粗糙度值", Pnt6, "CCD", "")
objAtt.Alignment = acAlignmentBottomRight
objAtt.Move InsPnt, Pnt6
objAtt.color = acByBlock
End If
Dim objBlockRef As AcadBlockReference
Set objBlockRef = ThisDrawing.ModelSpace.InsertBlock(InsertPoint, BlkName, Factor, Factor, Factor, angle)
Dim objAtts As Variant
objAtts = objBlockRef.GetAttributes
Dim objAttRef As AcadAttributeReference
Set objAttRef = objAtts(0)
objAttRef.TextString = Value
If angle > Radians(90) And angle 楼主好啊，我还是看的不是很懂
McCAD是什么意思啊？
我做的毕业设计是用VB实现粗糙度的快速标注，你说的这些事不是对我的很有用处啊？ |
|
置顶卡
