Excel to CAD 绘图技术

905738810

四月星空 发表于 2020-7-17 15:29
实例好像，没有对应的宏哦

有啊，和演示的是一个文件

905738810

接着说多段线，前面讲了多段线的的创建方法，但是只能创建出由直线段组成的多段线，今天讲解如何绘制圆弧多段线。
绘制圆弧多段线只有一个方法，就是设置多段线的凸度。
方法：多段线对象.SetBulge 索引, 凸度
2个参数，第一参数是指定线段的索引，从0开始，类型整数型
                第二参数是指定线段凸度，类型双精度
何为凸度？
凸度被用来表示一个顶点的弧度大小，它的值是这段弧所包含角度的1/4角度的正切。如果弧从起点到终点是顺时针走向则凸度为负数，0表示直线，1表示半圆。
看了之后还是没懂，没关系，写好函数直接调用就好了。

1. Public Function JtoT(ByVal J As Double) As Double '角度转凸度
   
2.     Pi = Atn(1) * 4
   
3.     J = J / 180 * Pi
   
4.     JtoT = Tan(J / 4) '凸度
   
5. End Function

复制代码

通过此函数就转化成，用圆弧角度控制圆弧的大小。
方法改成：多段线对象.SetBulge 索引, JtoT(圆弧角度）
示例：画一个三角形，第一条线段改为90度圆弧

1. Sub LWPline2()
   
2.     Dim doct As Object
   
3.     Set doct = doc
   
4.     If doct Is Nothing Then Exit Sub
   
5.     Dim ptArr(5) As Double
   
6.     ptArr(0) = 0: ptArr(1) = 0
   
7.     ptArr(2) = 100: ptArr(3) = 0
   
8.     ptArr(4) = 50: ptArr(5) = 50
   
9.     Set LWPline1 = doct.ModelSpace.AddLightWeightPolyline(ptArr)
   
10.     LWPline1.Closed = True
    
11.     LWPline1.SetBulge 0, JtoT(90) '更改为90度圆弧
    
12. End Sub

复制代码

905738810

示例2：画一条多段线，第一段是直线。第二段是圆弧，圆弧与直线相切：如图。

分析：多段线画圆弧，只要算出角度J然后设置多段线的凸度就可以了
计算角度J似乎也很麻烦，数学基础不好的压力很大啊。
但是不要忽略CAD最强大的地方，就是几何图形，他就相当于一个几何计算器。
我们遇到几何问题都可以画出图形，再去读取图形属性，来获得想要的数值，最后在删掉图形。示例代码：

1. Sub LWPline3()
   
2.     Dim doct As Object
   
3.     Set doct = doc
   
4.     If doct Is Nothing Then Exit Sub
   
5.     Dim ptArr(5) As Double
   
6.     ptArr(0) = 0: ptArr(1) = 0
   
7.     ptArr(2) = 100: ptArr(3) = 80
   
8.     ptArr(4) = 200: ptArr(5) = 30
   
9.     Set LWPline1 = doct.ModelSpace.AddLightWeightPolyline(ptArr)
   
10.     LWPline1.Closed = False
    
11.     Dim pt1(2) As Double, pt2(2) As Double, pt3(2) As Double
    
12.     pt1(0) = ptArr(0): pt1(1) = ptArr(1): pt1(2) = 0
    
13.     pt2(0) = ptArr(2): pt2(1) = ptArr(3): pt2(2) = 0
    
14.     pt3(0) = ptArr(4): pt3(1) = ptArr(5): pt3(2) = 0
    
15.     J = PLtoJ(pt1, pt2, pt3) '获得角度（弧度制）
    
16.     J = HtoJ(J) '自定义弧度转角度函数
    
17.     LWPline1.SetBulge 1, JtoT(J)
    
18. End Sub
    
19. 
    
20. Public Function PLtoJ(ByRef pt1() As Double, ByRef pt2() As Double, ByRef pt3() As Double) As Double '计算角度J
    
21.     Dim doct As Object
    
22.     Set doct = doc
    
23.     If doct Is Nothing Then Exit Function
    
24.     Dim line1 As AcadLine, line2 As AcadLine
    
25.     Pi = Atn(1) * 4
    
26.     J1 = doct.Utility.AngleFromXAxis(pt1, pt2) + Pi / 2 '计算点pt1, pt2角度
    
27.     pt4 = doct.Utility.PolarPoint(pt2, J1, 100) '取从点pt2按角度J1长度100的坐标
    
28.     Set line1 = doct.ModelSpace.AddLine(pt2, pt4) '绘制圆心与起点所在直线
    
29.    
    
30.     J2 = doct.Utility.AngleFromXAxis(pt3, pt2) + Pi / 2
    
31.     Dim pt5(2) As Double
    
32.     pt5(0) = (pt3(0) + pt2(0)) / 2
    
33.     pt5(1) = (pt3(1) + pt2(1)) / 2
    
34.     pt5(2) = 0
    
35.     pt4 = doct.Utility.PolarPoint(pt5, J2, 100) '取从点pt5按角度J2长度100的坐标
    
36.     Set line2 = doct.ModelSpace.AddLine(pt5, pt4) '绘制垂直平分线直线
    
37.     pt = line2.IntersectWith(line1, 3) '获得垂直平分线line2与圆心与起点所在直线line1交点，（圆心）
    
38.     J3 = doct.Utility.AngleFromXAxis(pt, pt3) '计算终止角度
    
39.     If J3 > J1 Then
    
40.         PLtoJ = (J3 - J1) - 2 * Pi
    
41.     Else
    
42.         PLtoJ = J3 - J1
    
43.     End If
    
44.     line1.Delete: line2.Delete '删除辅助图形
    
45. End Function
    
46. 
    
47. Public Function JtoT(ByVal J As Double) As Double '角度转凸度
    
48.     Pi = Atn(1) * 4
    
49.     J = J / 180 * Pi
    
50.     JtoT = Tan(J / 4) '凸度
    
51. End Function
    
52. 
    
53. Function HtoJ(ByVal h As Double) As Double '弧度转角度
    
54. Pi = Atn(1) * 4
    
55. HtoJ = h / Pi * 180
    
56. End Function

复制代码

梧叶沙沙

戴维351006616 发表于 2020-7-14 09:10
这不是CAD VBA本身的应用吗  我还以为EXCEL绘制图元呢  楼主这是在水贴

楼主的标题本来就是EXCEL to  CAD。

梧叶沙沙

905738810 发表于 2020-7-14 14:44
对于你可能知道很多地方都有教程，可是eh里的人不一定都是像你一样知道去哪里找，你可以分享出链接来，让 ...

别理这个杠精。这么多回复，说明需要他的人很多。楼主加油。

905738810

梧叶沙沙 发表于 2020-7-18 23:24
别理这个杠精。这么多回复，说明需要他的人很多。楼主加油。

谢谢支持

vip_ca

不支持64位

905738810

vip_ca 发表于 2020-7-19 10:48
不支持64位

我电脑装的32位，所以按32位写的，64位api声明需要加 PtrSafe

高度保密

905738810 发表于 2020-7-13 13:31
首先怕新人不知道弧度与角度转换关系，写了两个函数。
上回圆弧方法我又说了CADVBA中画圆弧方法只有这一种 ...

画圆弧的自定义函数会出错。这句    stAng = doct.Utility.AngleFromXAxis(ptCen, ptSt) '取得起始角度。
类似的都通不过

905738810

高度保密 发表于 2020-7-19 14:15
画圆弧的自定义函数会出错。这句    stAng = doct.Utility.AngleFromXAxis(ptCen, ptSt) '取得起始角度。 ...

参数ptCen和ptSt必须是双精度数组，例如Dim ptCen(2) As Double
看看doct变量是不是赋值了文档对象，我的例子中doct变量声明了全局变量。
Dim doct As Object
Function doc() As Object '引用已经打开的CAD
On Error Resume Next
    Set ACADApp = GetObject(, "AutoCAD.Application")
    If Err Then '出错就是没有打开CAD
        Err.Clear
        MsgBox "请打开CAD"
        Set doc = Nothing
    Exit Function
    End If
    Set doc = ACADApp.ActiveDocument '获取当前激活的文档
End Function
如果还出错，发个报错截图和文件，我帮你看看