CADVBA求出点到线间的距离,即垂线

《CADVBA求出点到线间的距离,即垂线》由会员分享，可在线阅读，更多相关《CADVBA求出点到线间的距离,即垂线（2页珍藏版）》请在装配图网上搜索。

1、PublicFunctionptoline(mylineAsAcadLine,mypAsVariant)AsAcadLine空间一点到某IDimmysetsAsAcadSelectionSetsDimmysetAsAcadSelectionSetSetmysets=ThisDrawing.selectionSetsForEachmysetInmysetsIfmyset.Name=qqqThenmyset.DeleteExitForEndIfNextSetmyset=ThisDrawing.selectionSets.Add(qqq)ThisDrawing.Utility.Prompt(请选择直

2、线段)myset.SelectOnScreenIfmyset.Count1ThenMsgBox本程序适用于单根线段和单个点，所选图元数量不符要求，将即退出ExitFunctionEndIfDimmyentityAsAcadEntityForEachmyentityInmysetIfmyentity.ObjectName=AcDbLineThenSetmyline=myentityElse:MsgBox所选图元不是线段，无法为你完成任务，抱谦，程序即将结束&vbLf&AcDbLineExitFunctionEndIfNextmyp=ThisDrawing.Utility.GetPoint(,请选

3、择点)Dimmypxy(2)AsDoublemypxy(2)=0mypxy(0)=myp(0)mypxy(1)=myp(1)Dimmylineendpxy(2)AsDoubleDimmylinestartpxy(2)AsDoublemylineendpxy(2)=0mylineendpxy(0)=myline.EndPoint(0)mylineendpxy(1)=myline.EndPoint(1)mylinestartpxy(2)=0mylinestartpxy(0)=myline.StartPoint(0)mylinestartpxy(1)=myline.StartPoint(1)Dimm

4、ylinexyAsAcadLineSetmylinexy=ThisDrawing.ModelSpace.AddLine(mylinestartpxy,mylineendpxy)mypxyoffset=ThisDrawing.Utility.PolarPoint(mypxy,myline.Angle+2*Atn(1),1000)Dimmylinexytemp1AsAcadLineSetmylinexytemp1=ThisDrawing.ModelSpace.AddLine(mypxyoffset,mypxy)DimmypxyunionAsVariantmypxyunion=mylinexytem

5、p1.IntersectWith(mylinexy,acExtendBoth)mypxyunion(2)=myp(2)mylinexy.Deletemylinexytemp1.DeleteDimmylinecopyAsAcadLineSetmylinecopy=myline.Copymylinecopy.Rotate3Dmypxyoffset,mypxy,2*Atn(1)mylinecopy.Movemylinecopy.EndPoint,mypxyunionDimmynedpAsVariantmynedp=mylinecopy.IntersectWith(myline,acExtendBot

6、h)mylinecopy.DeleteDimmynedlineAsAcadLineSetmynedline=ThisDrawing.ModelSpace.AddLine(mynedp,myp)mynedline.color=acBlueT=你所需要的垂线巳经为你画毕，其长度为：&Space(4)&Round(mynedline.Length,3)T=T&vbLf&本程序由江苏溧阳吴志明为你提供&vbLf&能为你效劳，我感到非常高I!MsgBoxTEndFunctionSubptolineobj()DimmyliAsAcadLineDimmypAsVariantDimmewAsAcadLineSetmew=ptoline(myli,myp)EndSub