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

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

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) [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 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

[code]
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 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编的程序)

发表回复

精选推荐