路边 发表于 2007-2-9 15:41:00

已知一条直线和直线外一点求垂足??

<p>求助:已知一条线两端点坐标(x1,y1);(x2,y2)和直线外一点(x3,y3),用VBA怎样求出垂足????请那位老兄给个代码!!!</p>

wyj7485 发表于 2007-2-9 17:14:00

<p>提问前先搜索下，有的:</p><p><a href="http://www.mjtd.com/BBS/dispbbs.asp?BoardID=4&amp;replyID=61741&amp;id=27865&amp;skin=0">http://www.mjtd.com/BBS/dispbbs.asp?BoardID=4&amp;replyID=61741&amp;id=27865&amp;skin=0</a></p>

jkbanana 发表于 2007-2-9 19:17:00

本帖最后由 作者 于 2007-2-9 19:19:43 编辑 <br /><br /> <p>Option Explicit<br/>Public Sub Sample()<br/>&nbsp; Dim objline As AcadLine<br/>&nbsp; Dim lineObj As AcadLine<br/>&nbsp; Dim returnPnt As Variant<br/>&nbsp; Dim sp(0 To 2) As Double<br/>&nbsp; Dim ep(0 To 2) As Double<br/>&nbsp; Dim ang As Double<br/>&nbsp; Dim pt(0 To 2) As Double<br/>&nbsp; Const pi = 3.14159</p><p>&nbsp; '1. 一条线两端点坐标(x1,y1);(x2,y2) ：设该直线为objline<br/>&nbsp; '&nbsp;&nbsp; 如果只有两端点坐标(x1,y1);(x2,y2), 可用 addline 方法画出该直线<br/>&nbsp; ThisDrawing.Utility.GetEntity objline, pt, "Select a line"<br/>&nbsp; ang = objline.Angle<br/>&nbsp; returnPnt = ThisDrawing.Utility.GetPoint(, "Enter a point: ")<br/>&nbsp; sp(0) = returnPnt(0)<br/>&nbsp; sp(1) = returnPnt(1)<br/>&nbsp; sp(2) = returnPnt(2)</p><p>&nbsp; '2.做直线objline的垂线lineObj<br/>&nbsp; ep(0) = sp(0) + Cos(ang + pi / 2)<br/>&nbsp; ep(1) = sp(1) + Sin(ang + pi / 2)<br/>&nbsp; ep(2) = sp(2)<br/>&nbsp; Set lineObj = ThisDrawing.ModelSpace.AddLine(sp, ep)<br/>&nbsp; <br/>&nbsp; '3.找出直线objline和它的垂线lineObj的交点pt<br/>&nbsp; returnPnt = lineObj.IntersectWith(objline, acExtendNone)<br/>&nbsp; If VarType(returnPnt) &lt;&gt; vbEmpty Then<br/>&nbsp;&nbsp;&nbsp;&nbsp; If LBound(returnPnt) &lt;= UBound(returnPnt) Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; pt(0) = returnPnt(0)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; pt(1) = returnPnt(1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; pt(2) = returnPnt(2)<br/>&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp; End If<br/>&nbsp; returnPnt = lineObj.IntersectWith(objline, acExtendBoth)<br/>&nbsp; If VarType(returnPnt) &lt;&gt; vbEmpty Then<br/>&nbsp;&nbsp;&nbsp;&nbsp; If LBound(returnPnt) &lt;= UBound(returnPnt) Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; pt(0) = returnPnt(0)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; pt(1) = returnPnt(1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; pt(2) = returnPnt(2)<br/>&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp; End If<br/>&nbsp; lineObj.Delete<br/>&nbsp; <br/>&nbsp; '4.画垂线<br/>&nbsp; Dim obj1 As AcadLine<br/>&nbsp; Set obj1 = ThisDrawing.ModelSpace.AddLine(sp, pt)<br/>End Sub<br/></p>

兰州人 发表于 2007-2-18 10:18:00

<p></p><p>如何是空间任意直线,你这种就有局限了.你这个公式是解决X-Y平面的.</p><p>我不会3X3矩阵的展开式.你能将下列成</p><p>X=??</p><p>Y= ??</p><p>Z = ??</p><p>形体的旋转变换有绕主轴旋转，或绕空间任一直线旋转等多种形式。若令Rθ表示绕z轴转θ角，Rβ表示绕y轴转β角，Rγ表示绕x轴转γ角，则点P绕x、y、z轴转γ、β、θ角的变换公式是<br/>Ｒ＝RθRβRγ<br/>&nbsp;&nbsp;&nbsp;&nbsp; |&nbsp; cosθ&nbsp;&nbsp; sinθ&nbsp;&nbsp; 0 |<br/>Rθ＝ | -sinθ&nbsp;&nbsp; cosθ&nbsp;&nbsp;&nbsp; 0&nbsp; |<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; |&nbsp; 0&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 0&nbsp;&nbsp;&nbsp;&nbsp; 1&nbsp; |</p><p><br/>&nbsp;&nbsp;&nbsp;&nbsp; |&nbsp; cosβ&nbsp; -sinβ&nbsp;&nbsp; 0&nbsp; |<br/>Rβ＝ |&nbsp;&nbsp; 0&nbsp;&nbsp;&nbsp;&nbsp; 1&nbsp;&nbsp;&nbsp;&nbsp; 0&nbsp;&nbsp; |<br/>&nbsp;&nbsp;&nbsp;&nbsp; |&nbsp; sinβ&nbsp; cosβ&nbsp;&nbsp;&nbsp; 1&nbsp;&nbsp; |</p><p>&nbsp;&nbsp;&nbsp;&nbsp; |&nbsp; 1&nbsp;&nbsp;&nbsp;&nbsp; 0&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 0&nbsp;&nbsp; |<br/>Rγ＝ |&nbsp; 0&nbsp;&nbsp;&nbsp; cosγ&nbsp;&nbsp; sinγ&nbsp; |<br/>&nbsp;&nbsp;&nbsp;&nbsp; |&nbsp; 0&nbsp;&nbsp;&nbsp;&nbsp; -sinγ&nbsp; cosγ |<br/></p><p></p>

biztech 发表于 2007-2-26 14:52:00

<p>三楼的函数有问题吧,</p><p>ep(0) = sp(0) + Cos(ang + pi / 2)<br/>ep(1) = sp(1) + Sin(ang + pi / 2)</p><p>这部分没有乘上垂线长度.<br/></p>
页: [1]
查看完整版本: 已知一条直线和直线外一点求垂足??