明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
楼主: zzyong00

用VB6进行Autocad的二次开发(原创)

    [复制链接]
 楼主| 发表于 2014-10-25 22:30 | 显示全部楼层
我发现用vb开发的几乎没有啊
 楼主| 发表于 2014-10-25 22:57 | 显示全部楼层
本帖最后由 zzyong00 于 2014-10-25 22:58 编辑

2、坐标标注
坐标标注本身很简单,类似的工具满天飞,我这里也贴一个


  1. Public Sub SeriesCoordinate()                                                   '连续标坐标
  2.     Dim blnExitSeriesCoord As Boolean
  3.     ' InitCommonVar
  4.     '全局变量
  5.     Coordinate_TextHeight = 3
  6.     ratio = 1
  7.     TextRowSpace = 0.6

  8.     Do
  9.         Coordinate blnExitSeriesCoord '本子过程源码需要回复才能看到
  10.     Loop Until blnExitSeriesCoord
  11. End Sub

  1.     On Error GoTo err1
  2.     '    Dim Coordinate_TextHeight As Double '文字高
  3.     '    Dim Ratio As Double '全局比例
  4.     '    Dim TextRowSpace As Double '文字行间距
  5.     '    Coordinate_TextHeight = 3
  6.     '    Ratio = 1
  7.     '    TextRowSpace = 0.6
  8.     Dim p1, p2                                                                  '标注点坐标,标注文字位置
  9.     p1 = ThisDrawing.Utility.GetPoint(, "请点击要标注的点(按回车键退出):")
  10.     p2 = ThisDrawing.Utility.GetPoint(p1, "请点击标注位置(按回车键退出):")
  11.     Dim T1   As AcadText, T2 As AcadText
  12.     Dim strT As String, intStrL1 As Integer, intStrL2 As Integer                'Y和X坐标文字的长度
  13.     strT = "X " & Format$(p1(1), "0.000")
  14.     intStrL1 = Len(strT)
  15.     Dim pt1(2) As Double, pt2(2) As Double                                      '文字坐标
  16.     If p2(0) > p1(0) Then                                                       '确定标注点与标注文字位置的左右关系,以确定文字插入点
  17.         pt1(0) = p2(0)
  18.         pt1(1) = p2(1) + TextRowSpace / 2 * Coordinate_TextHeight * ratio
  19.     Else
  20.         pt1(0) = p2(0) - intStrL1 * Coordinate_TextHeight * ratio * _
  21.         ThisDrawing.ActiveTextStyle.Width ^ 2                                   '宽度比例(总是宽度比例的平方,因为当前文字样式设了宽度,而AcadText本身又有个ScaleFactor,而且等于width)
  22.         pt1(1) = p2(1) + TextRowSpace / 2 * Coordinate_TextHeight * ratio
  23.     End If
  24.     Set T1 = ThisDrawing.ModelSpace.AddText(strT, pt1, Coordinate_TextHeight * ratio)
  25.     T1.Visible = False
  26.     strT = "Y " & Format$(p1(0), "0.000")
  27.     intStrL2 = Len(strT)
  28.     pt2(0) = pt1(0)
  29.     pt2(1) = pt1(1) - T1.Height * (1 + TextRowSpace)                            'TextRowSpace代表文字间距是TextRowSpace倍的字高
  30.     Set T2 = ThisDrawing.ModelSpace.AddText(strT, pt2, Coordinate_TextHeight * ratio)
  31.     T2.Visible = False
  32.     Dim Pend(2) As Double                                                       '标注结束点
  33.     Pend(0) = p2(0)
  34.     Dim TminP, TmaxP
  35.     If intStrL1 > intStrL2 Then                                                 '取最长文字长度
  36.         T1.GetBoundingBox TminP, TmaxP
  37.     Else
  38.         T2.GetBoundingBox TminP, TmaxP
  39.     End If
  40.     If p2(0) > p1(0) Then                                                       '确定标注点与标注文字位置的左右关系,以确定标注结束点位置
  41.         Pend(0) = p2(0) + (TmaxP(0) - TminP(0))
  42.         Pend(1) = p2(1)
  43.     Else
  44.         Pend(0) = p2(0) - (TmaxP(0) - TminP(0))
  45.         Pend(1) = p2(1)
  46.         pt1(0) = Pend(0)
  47.         pt2(0) = Pend(0)
  48.         T1.InsertionPoint = pt1
  49.         T2.InsertionPoint = pt2
  50.     End If
  51.     T1.Visible = True
  52.     T2.Visible = True

  53.     Dim L1 As AcadLine, L2 As AcadLine
  54.     Set L1 = ThisDrawing.ModelSpace.AddLine(p1, p2)
  55.     Set L2 = ThisDrawing.ModelSpace.AddLine(p2, Pend)
  56.     Exit Sub
  57. err1:
  58.     Err.Clear
  59.     blnExitSeriesCoord = True
  60. End Sub


对于vb或vba来说,在没创建AcadText对象之前,很难精确算出AcadText对象的长度,本例子中,先大致估算,然后生成AcadText对象,但暂时隐藏它,通过GetBoundingBox 取得AcadText对象真实大小后,再调整AcadText对象位置和直线长度!

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
回复 支持 2 反对 0

使用道具 举报

发表于 2014-10-26 16:31 | 显示全部楼层
zzyong00 发表于 2014-10-25 22:30
我发现用vb开发的几乎没有啊

很多,不要怀疑,等的花儿都谢了,
发表于 2014-10-26 20:30 | 显示全部楼层
楼主太强了。有空就来这里学习了。
发表于 2014-10-26 20:59 | 显示全部楼层
vb6是32位的 如何改写成更高版本的 .net支持64位呢

点评

vb.net与vb6在语法形式上有点相似,如果你想是可以改成.net的  发表于 2014-10-26 21:47
发表于 2014-11-3 16:45 | 显示全部楼层
很强大,学习了
发表于 2014-11-8 22:23 | 显示全部楼层
谢谢,正想学这方面的东西
发表于 2014-11-9 21:02 | 显示全部楼层
我也来学习一下
发表于 2014-11-19 13:08 | 显示全部楼层
我也来学习一下
发表于 2014-11-19 19:07 | 显示全部楼层
好好学习vba
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 07:20 , Processed in 0.326174 second(s), 18 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表