[求助]：过一点做直线的垂线？

dyheng

已知一直线和直线上的一点，有什么简单的方法能过该点作出已知直线的垂线？望高手能予指教

小美菜

先计算点到直线的距离，然后以该点为圆心以刚才的距离为半径绘一个圆，求该圆与直线的交点，即为所求！！

dyheng

谢谢指教，我已经会了，但2楼的方法不对，可能是叙述时说得词不达意，以致错了。利用求垂直平分线的方法，分别以垂足两边等距离的两点为圆心，以大于圆心到垂足距离的数值为半径做两个圆，交点即为两个要求点之一，再稍做一下判断，留下一个符合的点与垂足相连做直线即可。
我想找的是有没有更简单的方法可以达到同样目的，如果没有的话也就算了。

ljpnb

试试这个：

2. 
   
3. Sub test()
   
4. Dim lineobj1 As AcadLine
   
5. Dim lineobj2 As AcadLine
   
6. Dim pnt1 As Variant
   
7. Dim ang As Double
   
8. Dim pi As Double
   
9. pi = 4 * Atn(1)
   
10. ThisDrawing.Utility.GetEntity lineobj1, pnt, "select a line:"
    
11. ang = pi * 0.5
    
12. pnt1 = ThisDrawing.Utility.GetPoint(, "select a point:")
    
13. Set lineobj2 = lineobj1.Copy()
    
14. lineobj2.Rotate pnt1, ang
    
15. End Sub
    

<br /> Sub test()<br /> Dim lineobj1 As AcadLine<br /> Dim lineobj2 As AcadLine<br /> Dim pnt1 As Variant<br /> Dim ang As Double<br /> Dim pi As Double<br /> pi = 4 * Atn(1)<br /> ThisDrawing.Utility.GetEntity lineobj1, pnt, "select a line:"<br /> ang = pi * 0.5<br /> pnt1 = ThisDrawing.Utility.GetPoint(, "select a point:")<br /> Set lineobj2 = lineobj1.Copy()<br /> lineobj2.Rotate pnt1, ang<br /> End Sub<br />

ghhone

任意设一点,利用polarpoint方法求得坐标，再addline(pt1,pt2)

ndy888

题目的意思没有说清楚，分两种情况：
设直线两端点为AB，点为C
1、点在直线上，即已知垂足，很简单，求出AB与X轴的夹角（用AngleFromXAxis(Point1, Point2)）即可得到，此角加 PI/2 即为垂线与X轴夹角，用PolarPoint(Point, Angle, Distance)或极坐标，可得到垂线上任意一点坐标，垂线就可以画出来。
2、点在直线外，即垂足未知（这需要先判断点确实不在直线或其延长线上，可以分别求AC、BC与X轴夹角，非常接近0或PI 即为在直线上）。可以以AC或BC为直径，画圆，用IntersectWith(IntersectObject, ExtendOption)方法可以求出圆与AB的两个交点，其中一个为A（以AC为直径）或B点（以BC为直径），另一个为垂足D点。
AngleFromXAxis(Point1, Point2)比较好用，但在CAD中有时不太方便，比如在比较大的循环中使用时很耗时间，Undo时也比较麻烦。我一般习惯自己编写函数。以下是求直线AB与X轴夹角的函数，使用时要注意起点坐标在前，终点坐标在后，返回值为弧度。MConstdblPI为常量PI值，建议作为全局常量赋值，大小为3.14159265358979 。

2. Function GetAngle(mydblPntAX As Double, mydblPntAY As Double, mydblPntBX As Double, mydblPntBY As Double) As Double
   
3.     Dim dblDeltaX As Double
   
4.     Dim dblDeltaY As Double
   
5.     Dim dblTmpAngle As Double
   
6.     Dim dbltmpTGAngle As Double
   
7.     dblDeltaX = mydblPntBX - mydblPntAX
   
8.     dblDeltaY = mydblPntBY - mydblPntAY
   
9.         
   
10.     If dblDeltaX = 0 Then
    
11.         dblTmpAngle = IIf(dblDeltaY >= 0, MConstdblPI / 2, 3 * MConstdblPI / 2)
    
12.     Else
    
13.         If dblDeltaY = 0 Then
    
14.             dblTmpAngle = IIf(dblDeltaX >= 0, 0#, MConstdblPI)
    
15.         Else
    
16.             dbltmpTGAngle = dblDeltaY / dblDeltaX
    
17.             If dblDeltaX > 0 Then
    
18.                 dblTmpAngle = Atn(dbltmpTGAngle)
    
19.             Else
    
20.                 dblTmpAngle = Atn(dbltmpTGAngle) + MConstdblPI
    
21.             End If
    
22.         End If
    
23.     End If
    
24.     GetAngle = dblTmpAngle
    
25. End Function

Function GetAngle(mydblPntAX As Double, mydblPntAY As Double, mydblPntBX As Double, mydblPntBY As Double) As Double<br />     Dim dblDeltaX As Double<br />     Dim dblDeltaY As Double<br />     Dim dblTmpAngle As Double<br />     Dim dbltmpTGAngle As Double<br />     dblDeltaX = mydblPntBX - mydblPntAX<br />     dblDeltaY = mydblPntBY - mydblPntAY<br />         <br />     If dblDeltaX = 0 Then<br />         dblTmpAngle = IIf(dblDeltaY >= 0, MConstdblPI / 2, 3 * MConstdblPI / 2)<br />     Else<br />         If dblDeltaY = 0 Then<br />             dblTmpAngle = IIf(dblDeltaX >= 0, 0#, MConstdblPI)<br />         Else<br />             dbltmpTGAngle = dblDeltaY / dblDeltaX<br />             If dblDeltaX > 0 Then<br />                 dblTmpAngle = Atn(dbltmpTGAngle)<br />             Else<br />                 dblTmpAngle = Atn(dbltmpTGAngle) + MConstdblPI<br />             End If<br />         End If<br />     End If<br />     GetAngle = dblTmpAngle<br /> End Function