社区 › 源码共享 › 大家一起完善一个粗糙度标注的程序

mccad 发表于 2003-11-18 22:13:00

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

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

现在把已经写好的部分贴出来。是用匿名块方法，而且也只写了一部分，还没有写到交互操作部分。
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 <= Radians(270) Then
      Set objText = objBlock.AddText(Value, Pnt6, 3.5)
      objText.Alignment = acAlignmentTopLeft
      objText.Rotate InsPnt, Radians(180)
      objText.Move InsPnt, Pnt6
    Else
      Set objText = objBlock.AddText(Value, Pnt6, 3.5)
      objText.Alignment = acAlignmentBottomRight
      objText.Move InsPnt, Pnt6
    End If
    objText.color = acByBlock
    Dim blkname As String
    blkname = objBlock.Name
    Dim objBlockRef As AcadBlockReference
    Set objBlockRef = ThisDrawing.ModelSpace.InsertBlock(InsertPoint, blkname, Factor, Factor, Factor, Angle)
    Set CreateCCD = objBlockRef
End Function

Public Function PI() As Double
PI = Atn(1) * 4
End Function

Private Function Degrees(Radians As Double) As Double
Degrees = Radians / PI * 180
End Function

Private Function Radians(Degrees As Double) As Double
Radians = Degrees / 180 * PI
End Function

subtlation 发表于 2003-11-19 10:10:00

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

mccad 发表于 2003-11-19 11:46:00

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

以下为简单的程序调用部分，大家可以继续完善
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

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

' 粗糙度符号标注函数
' 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 <= Radians(270) Then
      objAttRef.Alignment = acAlignmentTopLeft
      objAttRef.Rotate objAttRef.TextAlignmentPoint, Radians(180)
    End If
End Function

Public Function PI() As Double
PI = Atn(1) * 4
End Function

Private Function Degrees(Radians As Double) As Double
Degrees = Radians / PI * 180
End Function

Private Function Radians(Degrees As Double) As Double
Radians = Degrees / 180 * PI
End Function

断桥 发表于 2003-11-23 17:36:00

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

zjxzdb21 发表于 2009-5-2 10:36:00

<p>楼主好啊，我还是看的不是很懂</p><p>McCAD是什么意思啊？</p><p>我做的毕业设计是用VB实现粗糙度的快速标注，你说的这些事不是对我的很有用处啊？</p>

查看完整版本: 大家一起完善一个粗糙度标注的程序