注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

零售创新,创新那些事儿,SPSS,VBA

零售创新

 
 
 

日志

 
 
关于我

新浪微博,零售创新 研究经理,数据分析师 希望和市场研究和零售业的同事共同进步! 本博客发表的都是免费或试用的资料,如果有版权问题请发邮件wangli12a@163.com联系删除。 spss excel vba blog

网易考拉推荐

CAD 线性标注 vba  

2010-09-14 17:59:25|  分类: VB和VBA知识 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
CAD 线性标注 vba
 

Sub KUANGAOBZ()
    Dim D(0 To 2) As Double
    Dim YD(0 To 2) As Double
    Dim ZD(0 To 2) As Double '极坐标半径中点
    Dim ptText&, ptText1&
    ptText = KuanTB.text
    D(0) = Val(TextBox5.text): D(1) = Val(TextBox6.text) - Val(GaoTB.text) - 200: D(2) = 0
    YD(0) = Val(TextBox5.text) + Val(KuanTB.text): YD(1) = Val(TextBox6.text) - Val(GaoTB.text) - 200: YD(2) = 0
     '计算中点坐标
    ZD(0) = (D(0) + YD(0)) / 2
    ZD(1) = (D(1) + YD(1)) / 2
    ZD(2) = (D(2) + YD(2)) / 2
   AddDimRotatedCTxt D, YD, ZD, 0
     Dim D1(0 To 2) As Double
    Dim YD1(0 To 2) As Double
    Dim ZD1(0 To 2) As Double '极坐标半径中点

ptText1 = GaoTB.text
    D1(0) = Val(TextBox5.text) + Val(KuanTB.text) + 200: D1(1) = Val(TextBox6.text) - Val(GaoTB.text): D1(2) = 0
    YD1(0) = Val(TextBox5.text) + Val(KuanTB.text) + 200: YD1(1) = Val(TextBox6.text): YD1(2) = 0
     '计算中点坐标
    ZD1(0) = (D1(0) + YD1(0)) / 2
    ZD1(1) = (D1(1) + YD1(1)) / 2
    ZD1(2) = (D1(2) + YD1(2)) / 2
   AddDimRotatedCTxt D1, YD1, ZD1, 90 * 3.141592 / 180#
   
End Sub
Public Function AddDimRotated(ByVal pt1 As Variant, ByVal pt2 As Variant, ByVal pt3 As Variant, ByVal pt4 As Variant) As AcadDimAligned
    Set AdimObj = ThisDrawing.ModelSpace.AddDimRotated(pt1, pt2, pt3, pt4)
      AdimObj.color = acGreen '标注颜色
      AdimObj.ArrowheadSize = 50 '标注箭头、引线箭头和钩线的尺寸
      AdimObj.TextHeight = 120 '指定标注或公差的文字高度
      AdimObj.ExtensionLineExtend= 50 '尺寸界线超出尺寸线的距离。
      AdimObj.ExtensionLineOffset = 100 '尺寸界线偏移起点的距离
End Function
Public Function AddDimRotatedCTxt(ByVal pt1 As Variant, ByVal pt2 As Variant, ByVal pt3 As Variant, ByVal pt4 As Variant) As AcadDimAligned
    Dim dimObj As AcadDimRotated
    Set dimObj = AddDimRotated(pt1, pt2, pt3, pt4)
End Function

*--------------------------------------------------------

'Sub biaozhu()
' Dim dimObj As AcadDimRotated
'Set dimObj = ThisDrawing.ModelSpace.AddDimRotated(D, YD, ZD, 0)
'       dimObj.color = acGreen '标注颜色
'       dimObj.ArrowheadSize = 8 '标注箭头、引线箭头和钩线的尺寸
'dimObj.TextHeight = 7 '指定标注或公差的文字高度
'dimObj.DecimalSeparator = "."'公制标注的小数点分隔符
'\'dimObj.UnitsFormat = acDimLScientific'指定除角度外的所有尺寸标注的单位格式。
'\'dimObj.FractionFormat = acDiagonal
'\'dimObj.FractionFormat = acHorizontal
'\'dimObj.FractionFormat = acNotStacked
'\'dimObj.TextOverride = "200"
'\'dimObj.TextPrefix = "L-"
'\'dimObj.TextSuffix = "长度"
'\'dimObj.TextRotation = 3.14159 / 4
'\'dimObj.Arrowhead1Block = "arrowBlk1" \'使用一个已定义的块取代第1个箭头
'\'dimObj.Arrowhead1Type = acArrowDefault \'定义箭头的显示形式
'\'dimObj.Arrowhead2Type = acArrowNone
'\'dimObj.DimLine1Suppress = True \'抑制第1个箭头的显示
'\'dimObj.DimLine2Suppress = True \'不抑制第2个箭头的显示(默认)
'\'dimObj.DimensionLineExtend = 30'尺寸界线超出尺寸线的距离。
'\'dimObj.ExtensionLineExtend = 5
'\'dimObj.TextGap = 3.5
'\'dimObj.TextInsideAlign = True
'\'dimObj.TextOutsideAlign = True
'\'dimObj.TextInside = True
'\'dimObj.TextMovement = acMoveTextAddLeader
'\'dimObj.VerticalTextPosition = acVertCentered
'\'dimObj.HorizontalTextPosition = acHorzCentered
'\'dimObj.DimLineInside = True
'\'dimObj.ForceLineInside = False
'\'dimObj.LinearScaleFactor = 10
'\'dimObj.ExtensionLineOffset = 10'尺寸界线偏移起点的距离
'\'dimObj.ToleranceJustification = acTolTop
'dimObj.ToleranceHeightScale = 0.9
'dimObj.TolerancePrecision = acDimPrecisionFour
'dimObj.ToleranceDisplay = acTolBasic
'dimObj.ToleranceUpperLimit = 0.002
'dimObj.ToleranceLowerLimit = 0.001
'\'dimObj.ToleranceSuppressLeadingZeros = True
'\'dimObj.ToleranceSuppressZeroInches = True
'\'dimObj.ToleranceSuppressZeroFeet = True
'\'dimObj.ExtLine1Suppress = True
'\'dimObj.Arrowhead1Type = acArrowOpen90
'dimObj.Fit = acArrowsOnly
'End Sub

*--------------------------------

'Sub Example_AddDimRotated()
'    ' 该示例在模型空间中创建水平和垂直标注。
'    Dim LineObj As AcadLine
'    Dim point1(0 To 2) As Double
'    Dim point2(0 To 2) As Double
'    Dim location(0 To 2) As Double
'    Dim rotAngle As Double
'    ' 定义标注
'    point1(0) = 0#: point1(1) = 0#: point1(2) = 0#
'    point2(0) = 5#: point2(1) = 5#: point2(2) = 0#
'    location(0) = 0#: location(1) = 0#: location(2) = 0#
'    '绘制直线
'    Set LineObj = ThisDrawing.ModelSpace.AddLine(point1, point2)
'    LineObj.color = acRed
'    ' 在模型空间中创建水平标注
'    rotAngle = 0
'    rotAngle = rotAngle * 3.141592 / 180#       ' 转换为弧度
'    Set dimObj = ThisDrawing.ModelSpace.AddDimRotated(point1, point2, location, rotAngle)
'    dimObj.color = acGreen
'    ' 在模型空间中创建垂直标注
'    rotAngle = 90
'    rotAngle = rotAngle * 3.141592 / 180#        ' 转换为弧度
'    Set dimObj = ThisDrawing.ModelSpace.AddDimRotated(point1, point2, location, rotAngle)
'    dimObj.color = acGreen
'    ThisDrawing.Application.ZoomExtents
'End Sub

  评论这张
 
阅读(1819)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017