任意两个点单坡，按此两点算坡任意内插点(黄点)
本帖最后由 yjycad 于 2017-12-22 02:30 编辑任意两个点单坡，按此两点算坡任意内插点lsp,谢谢。
yjycad 发表于 2018-1-2 13:51
你好，这个内插数据倒是正确的，怎么像cass一样直接形成点啊？谢谢！
不会cass，不懂你说的形成点是什么意思？n年前用过一次cass打网程序，感觉很差就再没有使用过。 哪位大师帮帮忙！谢谢:handshake Sub qiu_gc()
Dim a1 As Double, b1 As Double, c1 As Double
Dim a2 As Double, b2 As Double, c2 As Double
Dim x1 As Double, y1 As Double, z1 As Double
Dim x2 As Double, y2 As Double, z2 As Double
Dim x0 As Double, y0 As Double, z0 As Double
Dim x As Double, y As Double, ee As Double
Dim dlt As Double, dx As Double, dy As Double
ee = 0.000001
p1 = thisdrawing.Utility.GetPoint(, "第一点：")
p2 = thisdrawing.Utility.GetPoint(p1, "第二点：")
x1 = p1(0): y1 = p1(1): z1 = 200
x2 = p2(0): y2 = p2(1): z2 = 100
'直线方程系数
a1 = y2 - y1
b1 = x1 - x2
c1 = -a1 * x1 - b1 * y1
'求任意点标高
p0 = thisdrawing.Utility.GetPoint(, "任意点：")
x0 = p0(0): y0 = p0(1)
'垂线系数
a2 = b1
b2 = -a1
c2 = -a2 * x0 - b2 * y0
'求垂足
dlt = a1 * b2 - a2 * b1
dx = c1 * b2 - c2 * b1
dy = a1 * c2 - a2 * c1
If (Abs(dlt) < ee) Then
If (Abs(dx) < ee) And (Abs(dy) < ee) Then
x = 1E+20
y = 1E+20
Else
x = -1E+20
y = -1E+20
End If
Else
x = -dx / dlt
y = -dy / dlt
End If
'求z0=z
If x1 = x2 Then
bl = (y - y1) / (y1 - y2)
z = z1 + bl * (z1 - z2)
Else
bl = (x - x1) / (x1 - x2)
z = z1 + bl * (z1 - z2)
End If
'Debug.Print x, y, z
MsgBox "标高=" & Format(z, "##0.0000")
End Sub
ljq 发表于 2017-12-31 10:55
Sub qiu_gc()
Dim a1 As Double, b1 As Double, c1 As Double
Dim a2 As Double, b2 As Double,...
你好，这个内插数据倒是正确的，怎么像cass一样直接形成点啊？谢谢！ 还有没有哪个大师帮帮忙，谢谢！！！ yjycad 发表于 2018-1-12 00:58
还有没有哪个大师帮帮忙，谢谢！！！
cass点文件
Sub pt_cass()
Dim ss As AcadSelectionSet, point As AcadPoint
Dim x As Double, y As Double, z As Double
Set ss = thisdrawing.SelectionSets.Add("dsddsws")
ss.SelectOnScreen
If ss.Count = 0 Then ss.Delete: Exit Sub
Open "d:\cass_pt.dat" For Output As #1
For Each point In ss
i = i + 1
x = Format(point.Coordinates(0), "###0.000")
y = Format(point.Coordinates(1), "###0.000")
z = Format(point.Coordinates(2), "###0.000")
Write #1, i, , x, y, z
Next point
ss.Delete
Close #1
End Sub 在前面插值程序中，加入2个语句，生成插入点。当所有插值完毕后，采用上面程序生成点文件。
'Debug.Print x, y, z
p0(0) = x: p0(1) = y: p0(2) = z
thisdrawing.ModelSpace.AddPoint pt0
MsgBox "标高=" & Format(z, "##0.0000")
这是我写的第一个http://www.mjtd.com/forum.php?mod=viewthread&tid=175628&highlight=%C7%F3%D0%B1%C3%E6&mobile=2
页:
[1]
2