画线
下面这段代码要实现在三角网空间画任意直线求与三角形的交点坐标,以每一直线段为基本单元进行操作,autocad-vba编写存在的问题:
1、 直线与三角形交点数目正确,但画图时每段直线与三角形边交点会漏掉一二个点没画出来。
2、 代码中已过滤了重复坐标值,但画图时每段直线与三角形边交点会有一二处重复点出现,本来想上传图片可以比较直观看出来的,不熟悉这里的操作,传不上~~
希望得到指点,如何处理上述问题
代码如下:
Private Sub CommandButton6_Click()
'直线放样
SJWandDGXForm.Hide
Dim Cu_x() As Variant, Cu_y() As Variant
Dim Poly3dline As Variant
Dim TriangleNet As AcadSelectionSet
Dim ptt As AcadEntity
Dim ptt1 As AcadEntity
Dim g, gg, jj, j As Integer
Dim Point1(0 To 2) As Double, Point2(0 To 2) As Double, Point3(0 To 2) As Double
Dim Point4(0 To 2) As Double, Point5(0 To 2) As Double, Point6(0 To 2) As Double
Dim Point03(0 To 2) As Double, Point02(0 To 2) As Double
Dim point04(0 To 2) As Double, point05(0 To 2) As Double, point06(0 To 2) As Double
Dim newLayer As AcadLayer
Dim Tulayer As String
Tulayer = "样线"
Set newLayer = JTCLayer(Tulayer, 5)
ThisDrawing.ActiveLayer = ThisDrawing.Layers("0")
ThisDrawing.Layers("样线").Lock = False
ThisDrawing.Layers("样线").Freeze = False
ThisDrawing.Layers("样线").LayerOn = True
ThisDrawing.ActiveLayer = newLayer
Call CreatePolyline(Cu_x(), Cu_y())
With ThisDrawing
If .SelectionSets.Count > 0 Then .SelectionSets("CurrentSelection").Delete
Set TriangleNet = .SelectionSets.add("CurrentSelection")
Dim mode As Integer
ReDim gpCode(0) As Integer
ReDim dataValue(0) As Variant
Dim groupCode As Variant, dataCode As Variant
If UBound(Cu_x()) = 2 Then
Dim corner1(0 To 2) As Double
Dim corner2(0 To 2) As Double
mode = acSelectionSetCrossing
corner1(0) = Cu_x(0): corner1(1) = Cu_y(0): corner1(2) = 0
corner2(0) = Cu_x(1): corner2(1) = Cu_y(1): corner2(2) = 0
gpCode(0) = 8
dataValue(0) = "三角形,细化三角形,填充三角形,三角网"
groupCode = gpCode
dataCode = dataValue
TriangleNet.Select mode, corner1, corner2, groupCode, dataCode
Else
Dim ca_points() As Double
mode = acSelectionSetCrossingPolygon
For j = 0 To UBound(Cu_x()) - 1
ReDim Preserve ca_points(3 * j + 2)
ca_points(3 * j) = Cu_x(j)
ca_points(3 * j + 1) = Cu_y(j)
ca_points(3 * j + 2) = 0
Next
gpCode(0) = 8
dataValue(0) = "三角形,细化三角形,填充三角形,三角网"
groupCode = gpCode
dataCode = dataValue
TriangleNet.SelectByPolygon mode, ca_points, groupCode, dataCode
'TriangleNet.Highlight True
'TriangleNet.Update
End If
'判断样线顶点并求出坐标
Dim Cass_Text As AcadText
Dim pointobj1 As AcadPoint
Dim BL1, BL2, BL3, Bl4, Bl5 As Boolean
Dim AA, Ba, Ca, Da, Ha As Double
Dim Xf, Yf, Zf As Variant
Dim point4Value As Variant
Dim templ As Single
Dim polyint_x() As Variant
Dim polyint_y() As Variant
Dim collect As New Collection
Dim Cass_x0() As Double
Dim Cass_y0() As Double
Dim Cass_H0() As Double
Dim cvv As Integer
cvv = 0
For jj = 1 To UBound(Cu_x()) - 1
If collect.Count > 0 Then Set collect = Nothing
gg = 0
For Each ptt In TriangleNet
Poly3dline = ptt.Coordinates
If GetVertexCount(ptt) = 3 Then
Point4(0) = Round(Poly3dline(0), 3): Point4(1) = Round(Poly3dline(1), 3): Point4(2) = Round(Poly3dline(2), 3)
Point5(0) = Round(Poly3dline(3), 3): Point5(1) = Round(Poly3dline(4), 3): Point5(2) = Round(Poly3dline(5), 3)
Point6(0) = Round(Poly3dline(6), 3): Point6(1) = Round(Poly3dline(7), 3): Point6(2) = Round(Poly3dline(8), 3)
BL1 = Line2ToPoint(Point4(0), Point4(1), Point5(0), Point5(1), Round(Cu_x(jj - 1), 3), Round(Cu_y(jj - 1), 3), Round(Cu_x(jj), 3), Round(Cu_y(jj), 3), Xf, Yf)
BL2 = Line2ToPoint(Point5(0), Point5(1), Point6(0), Point6(1), Round(Cu_x(jj - 1), 3), Round(Cu_y(jj - 1), 3), Round(Cu_x(jj), 3), Round(Cu_y(jj), 3), Xf, Yf)
BL3 = Line2ToPoint(Point6(0), Point6(1), Point4(0), Point4(1), Round(Cu_x(jj - 1), 3), Round(Cu_y(jj - 1), 3), Round(Cu_x(jj), 3), Round(Cu_y(jj), 3), Xf, Yf)
If BL1 = True Or BL2 = True Or BL3 = True Then
gg = gg + 1
collect.add Item:=ptt, key:=CStr(gg)
End If
End If
Next
gg = collect.Count
ReDim Preserve Cass_x0(5 * gg + 4) '分配内存
ReDim Preserve Cass_y0(5 * gg + 4)
ReDim Preserve Cass_H0(5 * gg + 4)
cvv = cvv + gg
For Each ptt1 In collect
Poly3dline = ptt1.Coordinates
If GetVertexCount(ptt1) = 3 Then
Point1(0) = Round(Poly3dline(0), 3): Point1(1) = Round(Poly3dline(1), 3): Point1(2) = Round(Poly3dline(2), 3)
Point2(0) = Round(Poly3dline(3), 3): Point2(1) = Round(Poly3dline(4), 3): Point2(2) = Round(Poly3dline(5), 3)
Point3(0) = Round(Poly3dline(6), 3): Point3(1) = Round(Poly3dline(7), 3): Point3(2) = Round(Poly3dline(8), 3)
ReDim Preserve polyint_x(2) '分配内存
ReDim Preserve polyint_y(2)
polyint_x(0) = Point1(0): polyint_y(0) = Point1(1)
polyint_x(1) = Point2(0): polyint_y(1) = Point2(1)
polyint_x(2) = Point3(0): polyint_y(2) = Point3(1)
Bl4 = Point_in_Area(polyint_x(), polyint_y(), Round(Cu_x(jj - 1), 3), Round(Cu_y(jj - 1), 3))
Bl5 = Point_in_Area(polyint_x(), polyint_y(), Round(Cu_x(jj), 3), Round(Cu_y(jj), 3))
If Bl4 = True Then
AA = Point1(1) * (Point2(2) - Point3(2)) + Point2(1) * (Point3(2) - Point1(2)) + Point3(1) * (Point1(2) - Point2(2))
Ba = Point1(2) * (Point2(0) - Point3(0)) + Point2(2) * (Point3(0) - Point1(0)) + Point3(2) * (Point1(0) - Point2(0))
Ca = Point1(0) * (Point2(1) - Point3(1)) + Point2(0) * (Point3(1) - Point1(1)) + Point3(0) * (Point1(1) - Point2(1))
Da = -(AA * Point1(0) + Ba * Point1(1) + Ca * Point1(2))
Ha = -(AA * Round(Cu_x(jj - 1), 3) + Ba * Round(Cu_y(jj - 1), 3) + Da) / Ca
Point03(0) = Round(Cu_x(jj - 1), 3): Point03(1) = Round(Cu_y(jj - 1), 3): Point03(2) = Ha
Cass_x0(5 * gg + 0) = Point03(0)
Cass_y0(5 * gg + 0) = Point03(1)
Cass_H0(5 * gg + 0) = Point03(2)
End If
If Bl5 = True Then
AA = Point1(1) * (Point2(2) - Point3(2)) + Point2(1) * (Point3(2) - Point1(2)) + Point3(1) * (Point1(2) - Point2(2))
Ba = Point1(2) * (Point2(0) - Point3(0)) + Point2(2) * (Point3(0) - Point1(0)) + Point3(2) * (Point1(0) - Point2(0))
Ca = Point1(0) * (Point2(1) - Point3(1)) + Point2(0) * (Point3(1) - Point1(1)) + Point3(0) * (Point1(1) - Point2(1))
Da = -(AA * Point1(0) + Ba * Point1(1) + Ca * Point1(2))
Ha = -(AA * Round(Cu_x(jj), 3) + Ba * Round(Cu_y(jj), 3) + Da) / Ca
Point02(0) = Round(Cu_x(jj), 3): Point02(1) = Round(Cu_y(jj), 3): Point02(2) = Ha
Cass_x0(5 * gg + 4) = Point02(0)
Cass_y0(5 * gg + 4) = Point02(1)
Cass_H0(5 * gg + 4) = Point02(2)
End If
End If
Next
'与样线相交的△求出边交点
gg = 1
For Each ptt In collect
Poly3dline = ptt.Coordinates
If GetVertexCount(ptt) = 3 Then
Point4(0) = Round(Poly3dline(0), 3): Point4(1) = Round(Poly3dline(1), 3): Point4(2) = Round(Poly3dline(2), 3)
Point5(0) = Round(Poly3dline(3), 3): Point5(1) = Round(Poly3dline(4), 3): Point5(2) = Round(Poly3dline(5), 3)
Point6(0) = Round(Poly3dline(6), 3): Point6(1) = Round(Poly3dline(7), 3): Point6(2) = Round(Poly3dline(8), 3)
BL1 = Line2ToPoint(Point4(0), Point4(1), Point5(0), Point5(1), Round(Cu_x(jj - 1), 3), Round(Cu_y(jj - 1), 3), Round(Cu_x(jj), 3), Round(Cu_y(jj), 3), Xf, Yf)
BL2 = Line2ToPoint(Point5(0), Point5(1), Point6(0), Point6(1), Round(Cu_x(jj - 1), 3), Round(Cu_y(jj - 1), 3), Round(Cu_x(jj), 3), Round(Cu_y(jj), 3), Xf, Yf)
BL3 = Line2ToPoint(Point6(0), Point6(1), Point4(0), Point4(1), Round(Cu_x(jj - 1), 3), Round(Cu_y(jj - 1), 3), Round(Cu_x(jj), 3), Round(Cu_y(jj), 3), Xf, Yf)
If BL1 = True Or BL2 = True Or BL3 = True Then
If BL1 = True Then
AA = Point4(1) * (Point5(2) - Point6(2)) + Point5(1) * (Point6(2) - Point4(2)) + Point6(1) * (Point4(2) - Point5(2))
Ba = Point4(2) * (Point5(0) - Point6(0)) + Point5(2) * (Point6(0) - Point4(0)) + Point6(2) * (Point4(0) - Point5(0))
Ca = Point4(0) * (Point5(1) - Point6(1)) + Point5(0) * (Point6(1) - Point4(1)) + Point6(0) * (Point4(1) - Point5(1))
Da = -(AA * Point4(0) + Ba * Point4(1) + Ca * Point4(2))
Ha = -(AA * Xf + Ba * Yf + Da) / Ca
Zf = Ha
point04(0) = Xf: point04(1) = Yf: point04(2) = Zf
Dim fat As Boolean
fat = False
g = 0
For g = 0 To UBound(Cass_x0())
If point04(0) = Cass_x0(g) And point04(1) = Cass_y0(g) And point04(2) = Cass_H0(g) Then
fat = True
g = g + 1
End If
Next g
If fat = False Then
Cass_x0(5 * gg + 1) = point04(0)
Cass_y0(5 * gg + 1) = point04(1)
Cass_H0(5 * gg + 1) = point04(2)
End If
End If
If BL2 = True Then
AA = Point4(1) * (Point5(2) - Point6(2)) + Point5(1) * (Point6(2) - Point4(2)) + Point6(1) * (Point4(2) - Point5(2))
Ba = Point4(2) * (Point5(0) - Point6(0)) + Point5(2) * (Point6(0) - Point4(0)) + Point6(2) * (Point4(0) - Point5(0))
Ca = Point4(0) * (Point5(1) - Point6(1)) + Point5(0) * (Point6(1) - Point4(1)) + Point6(0) * (Point4(1) - Point5(1))
Da = -(AA * Point4(0) + Ba * Point4(1) + Ca * Point4(2))
Ha = -(AA * Xf + Ba * Yf + Da) / Ca
Zf = Ha
point05(0) = Xf: point05(1) = Yf: point05(2) = Zf
Dim fat1 As Boolean
fat1 = False
g = 0
For g = 0 To UBound(Cass_x0())
If point05(0) = Cass_x0(g) And point05(1) = Cass_y0(g) And point05(2) = Cass_H0(g) Then
fat1 = True
g = g + 1
End If
Next g
If fat1 = False Then
Cass_x0(5 * gg + 2) = point05(0)
Cass_y0(5 * gg + 2) = point05(1)
Cass_H0(5 * gg + 2) = point05(2)
End If
End If
If BL3 = True Then
AA = Point4(1) * (Point5(2) - Point6(2)) + Point5(1) * (Point6(2) - Point4(2)) + Point6(1) * (Point4(2) - Point5(2))
Ba = Point4(2) * (Point5(0) - Point6(0)) + Point5(2) * (Point6(0) - Point4(0)) + Point6(2) * (Point4(0) - Point5(0))
Ca = Point4(0) * (Point5(1) - Point6(1)) + Point5(0) * (Point6(1) - Point4(1)) + Point6(0) * (Point4(1) - Point5(1))
Da = -(AA * Point4(0) + Ba * Point4(1) + Ca * Point4(2))
Ha = -(AA * Xf + Ba * Yf + Da) / Ca
Zf = Ha
point06(0) = Xf: point06(1) = Yf: point06(2) = Zf
Dim fat2 As Boolean
fat2 = False
g = 0
For g = 0 To UBound(Cass_x0())
If point06(0) = Cass_x0(g) And point06(1) = Cass_y0(g) And point06(2) = Cass_H0(g) Then
fat2 = True
g = g + 1
End If
Next g
If fat2 = False Then
Cass_x0(5 * gg + 3) = point06(0)
Cass_y0(5 * gg + 3) = point06(1)
Cass_H0(5 * gg + 3) = point06(2)
End If
End If
End If
End If
gg = gg + 1
Next
Dim pnt() As Variant
Dim jn As Integer
jn = 0
For j = 0 To UBound(Cass_x0())
If Abs(Cass_x0(j)) > 0 And Abs(Cass_y0(j)) > 0 And Abs(Cass_H0(j)) > 0 Then
ReDim Preserve pnt(jn)
pnt(jn) = Point3d(Cass_x0(j), Cass_y0(j), Cass_H0(j))
jn = jn + 1
End If
Next j
MsgBox UBound(pnt)
'排序
PtList pnt, True, True, 0
Dim newtxt As String
newtxt = "坐标排序的顺序:"
Dim Cass_L() As Double
Dim pointobj As AcadPoint
For j = 0 To UBound(pnt)
If Abs(pnt(j)(0)) > 0 And Abs(pnt(j)(1)) > 0 And Abs(pnt(j)(2)) > 0 Then
ReDim Preserve Cass_L(3 * j + 2)
Cass_L(3 * j + 0) = pnt(j)(0)
Cass_L(3 * j + 1) = pnt(j)(1)
Cass_L(3 * j + 2) = pnt(j)(2)
newtxt = newtxt & vbCr & "第" & j + 1 & "点坐标为:" & pnt(j)(0) & " " & pnt(j)(1) & " " & pnt(j)(2)
If Cu_x(0) <= Cu_x(UBound(Cu_x())) Then
Set Cass_Text = ThisDrawing.ModelSpace.AddText(j + 1, pnt(j), 0.3)
Else
Set Cass_Text = ThisDrawing.ModelSpace.AddText(UBound(pnt) - j + 1, pnt(j), 0.3)
End If
Cass_Text.Color = acYellow
Set pointobj = .ModelSpace.AddPoint(pnt(j)) '点
.SetVariable "PDMODE", 35
.SetVariable "PDSIZE", 0.15
pointobj.Color = acGreen
End If
Next j
MsgBox newtxt
Dim Plineobj1 As Acad3DPolyline
Set Plineobj1 = ThisDrawing.ModelSpace.Add3DPoly(Cass_L) '画样线
Plineobj1.Lineweight = acLnWt020
ThisDrawing.Application.Update
Erase Cass_x0()
Erase Cass_y0()
Erase Cass_H0()
Erase pnt
Next jj
End With
TriangleNet.Clear
Set TriangleNet = Nothing
Unload Me
End Sub