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

zzyong00

增加一个判断点在pl曲线内侧还是外侧

1. '在模块中添加以下代码
   
2. Public Enum InOut
   
3.     Inside = -1
   
4.     Outside = 1
   
5. End Enum
   
6. 
   
7. Private Function InOutside(pl As AcadLWPolyline, P1 As Variant) As long
   
8.     'PL是要标注的PL线，P1是要监测是否在曲线内的点，三维DOUBLE数组
   
9.     '判断标注位置是否在PL范围内，可以设定坐标标在范围内还是外面
   
10.     'intInOut=-1是内侧，intInOut＝1是外侧,intInOut=0是不确定是内还是外
    
11.     Dim Ppl   As Variant
    
12.     Dim tmpPL As AcadLWPolyline
    
13.     Dim i     As Integer
    
14.     Set tmpPL = pl.Copy
    
15. 
    
16.     tmpPL.Closed = True
    
17.     tmpPL.Elevation = 0
    
18.     Ppl = tmpPL.Coordinates
    
19.     Dim dblYmax As Double                                                       'Y坐标最大值
    
20.     dblYmax = Ppl(1)
    
21.     For i = 3 To UBound(Ppl) Step 2                                            
    
22.         If dblYmax < Ppl(i) Then dblYmax = Ppl(i)
    
23.     Next i
    
24.     Dim tmpP(2) As Double                                                       '临时点
    
25.     tmpP(0) = P1(0)
    
26.     tmpP(1) = dblYmax + 100
    
27.     tmpP(2) = 0
    
28.     Dim objL As AcadLine
    
29.     Set objL = ThisDrawing.ModelSpace.AddLine(P1, tmpP)
    
30. 
    
31.     'ZoomAll
    
32.     Dim dblPoints As Variant
    
33.     dblPoints = objL.IntersectWith(tmpPL, acExtendNone)
    
34.     tmpPL.Delete
    
35.     objL.Delete                                                                 '清理战场
    
36.     'Debug.Print VarType(dblPoints) '即使没有交点，也是一个空的三维数组
    
37.     If UBound(dblPoints) = -1 Then                                          
    
38.         InOutside = Outside                                                   
    
39.         Exit Function
    
40.     End If
    
41.     If ((UBound(dblPoints) - LBound(dblPoints) + 1) / 3) Mod 2 Then             '交点个数为奇数，就在内侧；为偶数，就在外侧
    
42.         InOutside = Inside
    
43.     Else
    
44.         InOutside = Outside
    
45.     End If
    
46.     'Debug.Print InOutside
    
47. End Function
    

'在模块中添加以下代码<br /> Public Enum InOut<br />     Inside = -1<br />     Outside = 1<br /> End Enum<br /> <br /> Private Function InOutside(pl As AcadLWPolyline, P1 As Variant) As long<br />     'PL是要标注的PL线，P1是要监测是否在曲线内的点，三维DOUBLE数组<br />     '判断标注位置是否在PL范围内，可以设定坐标标在范围内还是外面<br />     'intInOut=-1是内侧，intInOut＝1是外侧,intInOut=0是不确定是内还是外<br />     Dim Ppl   As Variant<br />     Dim tmpPL As AcadLWPolyline<br />     Dim i     As Integer<br />     Set tmpPL = pl.Copy<br /> <br />     tmpPL.Closed = True<br />     tmpPL.Elevation = 0<br />     Ppl = tmpPL.Coordinates<br />     Dim dblYmax As Double                                                       'Y坐标最大值<br />     dblYmax = Ppl(1)<br />     For i = 3 To UBound(Ppl) Step 2                                            <br />         If dblYmax < Ppl(i) Then dblYmax = Ppl(i)<br />     Next i<br />     Dim tmpP(2) As Double                                                       '临时点<br />     tmpP(0) = P1(0)<br />     tmpP(1) = dblYmax + 100<br />     tmpP(2) = 0<br />     Dim objL As AcadLine<br />     Set objL = ThisDrawing.ModelSpace.AddLine(P1, tmpP)<br /> <br />     'ZoomAll<br />     Dim dblPoints As Variant<br />     dblPoints = objL.IntersectWith(tmpPL, acExtendNone)<br />     tmpPL.Delete<br />     objL.Delete                                                                 '清理战场<br />     'Debug.Print VarType(dblPoints) '即使没有交点，也是一个空的三维数组<br />     If UBound(dblPoints) = -1 Then                                          <br />         InOutside = Outside                                                    <br />         Exit Function<br />     End If<br />     If ((UBound(dblPoints) - LBound(dblPoints) + 1) / 3) Mod 2 Then             '交点个数为奇数，就在内侧；为偶数，就在外侧<br />         InOutside = Inside<br />     Else<br />         InOutside = Outside<br />     End If<br />     'Debug.Print InOutside<br /> End Function<br />

254619324

楼主非常厉害

lafare

vba也好景不长了，在64位vba7中不能调用vb6写的ActiveX DLL了，很郁闷~~~

zctao1966

”引用“ Autocad 200* Type Library这个引用，如果没装其它版本，怎么同时引用呢，才可以在其它版本都能用

zctao1966

感谢你的回复，如何后期绑定，请给个例子

zzyong00

今天再发一下求点集凸包和最小外接矩形的代码！

首先是测试代码，在vb窗体上放一个按钮，添加如下代码(其它未定义函数详见本贴前面的代码)：

1. Private Sub cmd凸包_Click()
   
2.     Dim objSset As AcadSelectionSet
   
3.     Dim objDoc As AcadDocument
   
4.     Set objDoc = ThisDrawing()
   
5.     AppActivate objCad.Caption
   
6.     SelectLots "MEA~PL~TMP~123", "point"
   
7.     Set objSset = objDoc.SelectionSets("MEA~PL~TMP~123")
   
8.     If objSset.Count = 0 Then Exit Sub
   
9.     objDoc.SetVariable "MODEMACRO", "计算中，请不在Autocad中执行其它操作！"
   
10.     Dim obj1 As AcadPoint ' AcadCircle ' AcadLWPolyline
    
11.     Dim i As Long
    
12.     ReDim pt(objSset.Count - 1)
    
13.     ReDim stack(objSset.Count - 1)
    
14.     For Each obj1 In objSset
    
15.         pt(i).x = obj1.Coordinates(0)
    
16.         pt(i).y = obj1.Coordinates(1)
    
17.         i = i + 1
    
18.     Next
    
19.     Call Hull(objSset.Count - 1)
    
20.     Dim Coords() As Double
    
21.     ReDim Coords(2 * (lngTop + 1) - 1)
    
22.     For i = 0 To lngTop
    
23.         Coords(2 * i) = stack(i).x
    
24.         Coords(2 * i + 1) = stack(i).y
    
25.     Next i
    
26.     Dim objPL As AcadLWPolyline
    
27.     Set objPL = objDoc.ModelSpace.AddLightWeightPolyline(Coords)
    
28.     objPL.Closed = True
    
29.     objDoc.Regen acActiveViewport
    
30.    
    
31.     Dim Coords2() As Double
    
32.    
    
33.     calMinRect lngTop, Coords2
    
34.     Set objPL = objDoc.ModelSpace.AddLightWeightPolyline(Coords2)
    
35.     objPL.Closed = True
    
36.     objDoc.Regen acActiveViewport
    
37.     objDoc.SetVariable "MODEMACRO", ""
    
38.    
    
39. End Sub

Private Sub cmd凸包_Click()<br />     Dim objSset As AcadSelectionSet<br />     Dim objDoc As AcadDocument<br />     Set objDoc = ThisDrawing()<br />     AppActivate objCad.Caption<br />     SelectLots "MEA~PL~TMP~123", "point"<br />     Set objSset = objDoc.SelectionSets("MEA~PL~TMP~123")<br />     If objSset.Count = 0 Then Exit Sub<br />     objDoc.SetVariable "MODEMACRO", "计算中，请不在Autocad中执行其它操作！"<br />     Dim obj1 As AcadPoint ' AcadCircle ' AcadLWPolyline<br />     Dim i As Long<br />     ReDim pt(objSset.Count - 1)<br />     ReDim stack(objSset.Count - 1)<br />     For Each obj1 In objSset<br />         pt(i).x = obj1.Coordinates(0)<br />         pt(i).y = obj1.Coordinates(1)<br />         i = i + 1<br />     Next<br />     Call Hull(objSset.Count - 1)<br />     Dim Coords() As Double<br />     ReDim Coords(2 * (lngTop + 1) - 1)<br />     For i = 0 To lngTop<br />         Coords(2 * i) = stack(i).x<br />         Coords(2 * i + 1) = stack(i).y<br />     Next i<br />     Dim objPL As AcadLWPolyline<br />     Set objPL = objDoc.ModelSpace.AddLightWeightPolyline(Coords)<br />     objPL.Closed = True<br />     objDoc.Regen acActiveViewport<br />     <br />     Dim Coords2() As Double<br />     <br />     calMinRect lngTop, Coords2<br />     Set objPL = objDoc.ModelSpace.AddLightWeightPolyline(Coords2)<br />     objPL.Closed = True<br />     objDoc.Regen acActiveViewport<br />     objDoc.SetVariable "MODEMACRO", ""<br />     <br /> End Sub

接下来是最主要的计算模块，编写的比较累，略收几个币，安慰一下自己：

charlesli8

楼主你下了不少功夫写这个插件啊！  受教了！  代码不错！

_梦游-

这个必须顶！

charlesli8

2. '//极角比较， 返回-1: p0p1 在 p0p2 的右侧，返回 0:p0,p1,p2 共线
   
3. Public Function Cmp_PolarAngel(P1 As point, P2 As point, pb As point) As Long
   
4.     Dim delta As Double
   
5.     delta = (P1.x - pb.x) * (P2.y - pb.y) - (P2.x - pb.x) * (P1.y - pb.y)
   
6.     If delta < 0# Then
   
7.         Cmp_PolarAngel = 1
   
8.     ElseIf delta = 0# Then
   
9.         Cmp_PolarAngel = 0
   
10.     Else
    
11.         Cmp_PolarAngel = -1
    
12.     End If

'//极角比较， 返回-1: p0p1 在 p0p2 的右侧，返回 0:p0,p1,p2 共线<br /> Public Function Cmp_PolarAngel(P1 As point, P2 As point, pb As point) As Long<br />     Dim delta As Double<br />     delta = (P1.x - pb.x) * (P2.y - pb.y) - (P2.x - pb.x) * (P1.y - pb.y)<br />     If delta < 0# Then<br />         Cmp_PolarAngel = 1<br />     ElseIf delta = 0# Then<br />         Cmp_PolarAngel = 0<br />     Else<br />         Cmp_PolarAngel = -1<br />     End If

这是个测试函数，里面的x y是怎么来的？还有delta = (P1.x - pb.x) * (P2.y - pb.y) - (P2.x - pb.x) * (P1.y - pb.y) 这句是怎么算的呀？

charlesli8

在那里问了后，过会就不见了。  更没有看到你的回复。