Hi all,
I like to draw line perpendicular to line using vba. Anyone have sample code?
Thanks
Ramanusu
Solved! Go to Solution.
Solved by Hallex. Go to Solution.
Try this code
Option Explicit '' based on code written by Tony Tanzillo '' request check "Break on Unhandled Errors" in General options Public Sub LoopExample() Dim ptColl As Collection Set ptColl = New Collection Dim intOsm As Integer intOsm = ThisDrawing.GetVariable("OSMODE") ThisDrawing.SetVariable "OSMODE", 35 Dim Msg As String Msg = vbCrLf & "First point: " Dim MyPoint As Variant Do On Error Resume Next MyPoint = ThisDrawing.Utility.GetPoint(, Msg) If Err Then Err.Clear Exit Do End If On Error GoTo 0 ptColl.Add MyPoint Msg = vbCrLf & "Next point [ or ENTER to exit ]: " Loop On Error GoTo 0 Dim oEntity As AcadEntity Dim varPt As Variant ThisDrawing.Utility.GetEntity oEntity, varPt, vbCr & "Select a projection oLine >> " If Not oEntity Is Nothing Then If TypeOf oEntity Is AcadLine Then Dim oLine As AcadLine Set oLine = oEntity Dim stPt As Variant, endPt As Variant stPt = oLine.StartPoint: endPt = oLine.EndPoint End If End If Dim Pi As Double Pi = Atn(1#) * 4 Dim ang As Double ang = ThisDrawing.Utility.AngleFromXAxis(stPt, endPt) Dim outColl As Collection Set outColl = New Collection Dim itm As Variant Dim num As Integer For num = 1 To ptColl.Count itm = ptColl.Item(num) Dim tmpPt1(2) As Double tmpPt1(0) = itm(0): tmpPt1(1) = itm(1): tmpPt1(2) = itm(2): Dim tmp As Variant tmp = ThisDrawing.Utility.PolarPoint(tmpPt1, ang - Pi / 2, 1) Dim tmpPt2(2) As Double tmpPt2(0) = tmp(0): tmpPt2(1) = tmp(1): tmpPt2(2) = tmp(2): Dim oXLine As AcadXline Set oXLine = ThisDrawing.ModelSpace.AddXline(tmpPt1, tmpPt2) Dim intPt As Variant intPt = oXLine.IntersectWith(oLine, acExtendNone) outColl.Add intPt oXLine.Delete Next num Dim i As Integer Dim j As Integer Dim dblDist As Double For i = 1 To outColl.Count Set oLine = ThisDrawing.ModelSpace.AddLine(outColl.Item(i), ptColl.Item(i)) Next i ThisDrawing.SetVariable "OSMODE", intOsm Set outColl = Nothing Set ptColl = Nothing End Sub
thank you Hallex for the code you posted
and, since I can't help doing it, here's my optimization or, better, what I think it is
Option Explicit '' based on code written by Tony Tanzillo '' request check "Break on Unhandled Errors" in General options
''' revised by RICVBA 22_02_2014
Public Sub LoopExample() Dim ptColl As Collection, outColl As Collection Dim intOsm As Integer, i As Integer Dim Msg As String Dim oEntity As AcadEntity Dim varPt As Variant, Pt1 As Variant, Pt2 As Variant Dim oLine As AcadLine, oXLine As AcadXline Dim Pi As Double, ang As Double intOsm = ThisDrawing.GetVariable("OSMODE") ThisDrawing.SetVariable "OSMODE", 35 Set ptColl = New Collection Msg = vbCrLf & "First point: " Do On Error Resume Next varPt = ThisDrawing.Utility.GetPoint(, Msg) If Err Then Err.Clear Exit Do End If On Error GoTo 0 ptColl.Add varPt Msg = vbCrLf & "Next point [ or ENTER to exit ]: " Loop On Error GoTo 0 ThisDrawing.Utility.GetEntity oEntity, varPt, vbCr & "Select a projection line >> " If Not oEntity Is Nothing Then If TypeOf oEntity Is AcadLine Then Set oLine = oEntity Pt1 = oLine.StartPoint: Pt2 = oLine.EndPoint Pi = Atn(1#) * 4 ang = ThisDrawing.Utility.AngleFromXAxis(Pt1, Pt2) Set outColl = New Collection For i = 1 To ptColl.Count Pt1 = ptColl.Item(i) Pt2 = ThisDrawing.Utility.PolarPoint(Pt1, ang - Pi / 2, 1) Set oXLine = ThisDrawing.ModelSpace.AddXline(Pt1, Pt2) outColl.Add oXLine.IntersectWith(oLine, acExtendNone) oXLine.Delete Next i For i = 1 To outColl.Count Set oLine = ThisDrawing.ModelSpace.AddLine(outColl.Item(i), ptColl.Item(i)) Next i Set outColl = Nothing End If End If ThisDrawing.SetVariable "OSMODE", intOsm Set ptColl = Nothing End Sub
I minimized variables number and made the code core run only If Not oEntity Is Nothing and TypeOf oEntity Is AcadLine
nothing you couldn't live without.
bye
a furtherly shorter (and presumibly faster) version
'' based on code written by Tony Tanzillo '' request check "Break on Unhandled Errors" in General options ''' revised by RICVBA 23_02_2014 Option Explicit Public Sub LoopExample() Dim intOsm As Integer Dim Msg As String Dim oEntity As AcadEntity Dim Pt1 As Variant, Pt2 As Variant Dim RefLine As AcadLine, oLine As AcadLine, oXLine As AcadXline Dim Pi As Double, ang As Double ThisDrawing.Utility.GetEntity oEntity, Pt1, vbCr & "Select a projection line >> " If Not oEntity Is Nothing Then If TypeOf oEntity Is AcadLine Then intOsm = ThisDrawing.GetVariable("OSMODE") ThisDrawing.SetVariable "OSMODE", 35 Set RefLine = oEntity Pt1 = RefLine.StartPoint: Pt2 = RefLine.EndPoint Pi = Atn(1#) * 4 ang = ThisDrawing.Utility.AngleFromXAxis(Pt1, Pt2) Msg = vbCrLf & "First point: " Do On Error Resume Next Pt1 = ThisDrawing.Utility.GetPoint(, Msg) If Err Then Err.Clear Exit Do End If On Error GoTo 0 Set oXLine = ThisDrawing.ModelSpace.AddXline(Pt1, ThisDrawing.Utility.PolarPoint(Pt1, ang - Pi / 2, 1)) Set oLine = ThisDrawing.ModelSpace.AddLine(Pt1, oXLine.IntersectWith(RefLine, acExtendNone)) oXLine.Delete Msg = vbCrLf & "Next point [ or ENTER to exit ]: " Loop On Error GoTo 0 ThisDrawing.SetVariable "OSMODE", intOsm End If End If End Sub
just for "research" purposes
Thanks a lot Hallex & Ricvba’s . quick replay. I will check and let you know, if I have any queries.
Bye
Ramanusu
It's working perfect. i tolk both codes. I have one more query posted. If you have time. Please have look. Thank you very much.