社区 › VB › 粗糙度标注-(McCad---2003-11-18编的程序)

兰州人 发表于 2007-11-22 13:50:00

粗糙度标注-(McCad---2003-11-18编的程序)

2003-11-18编的程序见
在这个粘子中采用的是匿名块技术，随后McCad又改为属性块的生成方法和属性块插入后的属性修改。
本着学习态度，对下语句进一步分析。
   Set objBlock =    ThisDrawing.Blocks.Add(InsPnt, "*U")   
    ThisDrawing.Utility.PolarPoint(InsPnt, Radians(60), 12)
    Set objBlockRef =      ThisDrawing.ModelSpace.InsertBlock(InsertPoint, blkname, Factor, Factor, Factor, Angle)   
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 Gets the point at a specified angle and distance from a given point.
以基点为坐标，按极坐标角和定长获得另一点坐标。
RetVal = PolarPoint(Point, Angle, Distance)
ThisDrawing.Utility 取得文档的Utility 对象。
RetVal = object.AddLine(StartPoint, EndPoint)
对于直线、多义线、圆等实体，采用thisdrwing.modespace
对于promt,getpoint等采用thisdrawing.Uitility
Uitility和ModeSpace区别在什么？？？？

兰州人 发表于 2007-11-22 15:25: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
CreateCCD1 mode, pnt, angle, txt, 1
End Sub
' 粗糙度符号标注函数
' Mode为粗糙度模式，0代表表面未加工，1代表表面加工
' InsertPoint为插入点
' Angle为插入的角度
' Value粗糙度值
' Factor为插入的比例因子
Function CreateCCD1(mode As Integer, InsertPoint As Variant, angle As Double, Value As String, Factor As Double) As AcadBlockReferenceDim 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 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
CreateCCD1 mode, pnt, angle, txt, 1
End Sub
' 粗糙度符号标注函数
' Mode为粗糙度模式，0代表表面未加工，1代表表面加工
' InsertPoint为插入点
' Angle为插入的角度
' Value粗糙度值
' Factor为插入的比例因子
Function CreateCCD1(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

兰州人 发表于 2007-11-22 16:51:00

呵呵，四年前的程序都被你抓出来。
现在想想看，这个程序应该也是对VBA及AutoCAD应用的一个比较好的例子了，因为使用了各种比较少用的技术来完成。

兰州人 发表于 2007-11-22 16:52:00

你这个程序相当实用性，我现在认真吸取你编程的思路。

查看完整版本: 粗糙度标注-(McCad---2003-11-18编的程序)