明经CAD社区

 找回密码
 注册

扫一扫,访问微社区

QQ登录

只需一步,快速开始

查看: 329|回复: 10

任意两个点单坡,按此两点算坡任意内插点(黄点)

[复制链接]
发表于 2017-12-20 00:34 | 显示全部楼层 |阅读模式
50明经币
本帖最后由 yjycad 于 2017-12-22 02:30 编辑

任意两个点单坡,按此两点算坡任意内插点lsp,谢谢。

附件: 您需要 登录 才可以下载或查看,没有帐号?注册
 楼主| 发表于 2017-12-29 21:01 | 显示全部楼层
哪位大师帮帮忙!谢谢
回复

使用道具 举报

发表于 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, 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
回复

使用道具 举报

 楼主| 发表于 2018-1-2 13:51 | 显示全部楼层
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一样直接形成点啊?谢谢!
回复

使用道具 举报

发表于 2018-1-8 13:25 | 显示全部楼层
yjycad 发表于 2018-1-2 13:51
你好,这个内插数据倒是正确的,怎么像cass一样直接形成点啊?谢谢!

不会cass,不懂你说的形成点是什么意思?n年前用过一次cass打网程序,感觉很差就再没有使用过。

评分

参与人数 1明经币 +1 收起 理由
yjycad + 1 很给力!

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2018-1-12 00:58 | 显示全部楼层
还有没有哪个大师帮帮忙,谢谢!!!

点评

你把cass形成的点发来看看,是属性块吗?  发表于 2018-1-12 08:25
回复

使用道具 举报

 楼主| 发表于 2018-1-12 19:06 | 显示全部楼层
yjycad 发表于 2018-1-12 00:58
还有没有哪个大师帮帮忙,谢谢!!!

cass点文件

本帖子中包含更多资源

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

x
回复

使用道具 举报

发表于 2018-1-16 10:57 | 显示全部楼层
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
回复

使用道具 举报

发表于 2018-1-16 11:00 | 显示全部楼层
在前面插值程序中,加入2个语句,生成插入点。当所有插值完毕后,采用上面程序生成点文件。
    'Debug.Print x, y, z
    p0(0) = x: p0(1) = y: p0(2) = z
    thisdrawing.ModelSpace.AddPoint pt0
    MsgBox "标高=" & Format(z, "##0.0000")
回复

使用道具 举报

发表于 2018-3-14 02:27 来自手机 | 显示全部楼层
这是我写的第一个http://www.mjtd.com/forum.php?mod=viewthread&tid=175628&highlight=%C7%F3%D0%B1%C3%E6&mobile=2
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2018-4-26 04:28 , Processed in 0.170407 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.3

© 2001-2013 Comsenz Inc.

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