Create Perpendicular Line at every intersection point

[priyanka_mehta]

Hi all,

 

I need a VBA code to create line at every intersection point. The start point of the line should be the intersection point (of two lines usually) and the end point is at the perpendicular of third line.

 

There are hundreds of such points so i really need a VBA code for it.

 

Thanks & Regards,

Priyanka

[SEANT]

This sounds like an interesting problem, especially if it requires 3D compatibility. Unfortunately, I don’t have time to look into it today.

 

If you could post a sample file, to better illustrate the parameters, I’ll see what I can do tomorrow or over the weekend.

[priyanka_mehta]

I have attached a screenshot. It is easy do it manually but not when u have hundereds of such points.

 

Please help,

 

Thanks and Regards,

Priyanka

[MaxwellEdison]

If the symbols are always the same size and spacing, perhaps the MEASURE command might work better? You could insert the taller set, stretch the line from its start point to match the spacing between the two, then insert the second set.

 

EDIT: Nevermind, I see that they are not.

[Lee Mac]

I suppose that you could use a Lisp in which the user would select the third line (the line which all the other ajoining lines are perpendicular to) and then the user would select each of the crosses in turn - the LISP adding the perpendicular line each time. But of course this would mean the user would have the tedious task of selecting all the crosses... I just can't see how o e could get ACAD to recognise that each of the pairs of lines was a cross which needed a line... But maybe VBA can accomplish such tasks...

[SEANT]

I’m assuming from the screen shot that we’re dealing strictly with 2D geometry. That’s fortunate because a 3D solution would likely be a lot more complicated.

 

Even with flat geometry the computations are numerous. The possible number of intersections increases geometrically with the size of the selection set (the situation alluded to by Lee Mac).

 

The routine below isn’t much better than a standard “brute force” method, so anything that can be done to limit the quantity of lines to only those pertinent will help with speed.

 

I’ve done limited testing and error checking, so proceed accordingly.

 

Sub Inters2Perp() 'Main sub
Dim SOS As AcadSelectionSet
Dim objSS As AcadSelectionSet
Dim intCode(1) As Integer
Dim varData(1) As Variant
Dim objEnt As AcadEntity
Dim entBaseLine As AcadLine
Dim colPt As New Collection
Dim ent As AcadEntity
Dim varPt As Variant


With ThisDrawing
  On Error Resume Next
  .Utility.GetEntity ent, varPt, "Select the line to which perpendiculars will land: "
  If Err <> 0 Or Not TypeOf ent Is AcadLine Then
     .Utility.Prompt "Operation aborted!" & vbCr
     Exit Sub
  End If
  On Error GoTo 0
  Set entBaseLine = ent
  

  For Each SOS In .SelectionSets
     If SOS.Name = "MySS" Then
        .SelectionSets("MySS").Delete
     Exit For
     End If
  Next
  
  intCode(0) = 0: varData(0) = "LINE"
  intCode(1) = 8: varData(1) = "*" 'replace * with layer name of crossing lines
  .SelectionSets.Add ("MySS")
  Set objSS = ThisDrawing.SelectionSets("MySS")
  objSS.SelectOnScreen intCode, varData
  
  
  If objSS.Count < 1 Then
     MsgBox "No lines and polylines selected!"
     Exit Sub
  End If
  
  Set colPt = GenCollection(objSS)
  GenLines colPt, entBaseLine
  
End With
End Sub

Function GenCollection(objSS As AcadSelectionSet) As Collection
Dim colPt As New Collection
Dim entPrimary As AcadLine
Dim entSecondary As AcadLine
Dim varPt As Variant
Dim i As Integer
Dim entObj(0) As AcadEntity
  Do While objSS.Count > 1
     Set entPrimary = objSS.Item(0)
     For i = 1 To objSS.Count - 1
        Set entSecondary = objSS.Item(i)
        varPt = entPrimary.IntersectWith(entSecondary, acExtendNone)
        If UBound(varPt) > 1 Then colPt.Add (varPt)
     Next
     Set entObj(0) = entPrimary
     objSS.RemoveItems entObj
  Loop
  Set GenCollection = colPt
End Function

Private Sub GenLines(colPt As Collection, entBaseLine As AcadLine)
Dim dblAngle As Double
Dim varPt As Variant
Dim dblEndPt() As Double
Dim entLine As AcadLine
dblAngle = ThisDrawing.Utility.AngleFromXAxis(entBaseLine.StartPoint, entBaseLine.EndPoint) + 1.5707963268
For Each varPt In colPt
  dblEndPt = ThisDrawing.Utility.PolarPoint(varPt, dblAngle, 1#)
  Set entLine = ThisDrawing.ModelSpace.AddLine(varPt, dblEndPt)
  On Error Resume Next
  entLine.EndPoint = entLine.IntersectWith(entBaseLine, acExtendThisEntity)
  If Err <> 0 Then entLine.Delete
  Err.Clear
Next
End Sub

[Lee Mac]

Ahhh, so it can be done... a lot of "trial and error" involved I assume...

[SEANT]

Ahhh, so it can be done... a lot of "trial and error" involved I assume...

 

Absolutely. The routine checks every selected line against every other selected line.

 

At first glance, I thought your post was saying 'a lot of "trial and error" involved' while writing the routine, and I thought "How did he know that?"

[SEANT]

For the sake of discussion:

 

Say this were a task that came up often, and dealt with extremely large sets of crossing lines (>10000), what would be a good optimization scheme?

 

I thought about generating a bounding box for the SS, then sub-dividing into nine or sixteen. A filtered selection set, based on the lines endpoints, could isolate bite size chunks. This would avoid a lot of failed tests for intersection, but potentially miss some of the target lines that were near the boarders.

[Lee Mac]

Yeah, as you say, having the routine compare every single combination of two lines is extremely tedious:

 

for instance, if one has 50 lines, if the program performs every combination of two lines, i.e. comparing line L1 with L2, but also L2 with L1 later on, the number of combinations would be something like:

 

[50!/48!] ~ 2450

 

But if the program knows that if it has compared L1 and L2, not to compare L2 with L1 later on, this number is reduced to:

 

[50!/2(48!)] ~ 1225

 

If my maths is correct! - (stats was never my strong point!)

 

But dividing it up would help somewhat, as the number of calculations would be greatly reduced - but obviously the accuracy of the routine is also impaired somewhat..

 

tough call.

[SEANT]

Yeah, as you say, having the routine compare every single combination of two lines is extremely tedious:

 

for instance, if one has 50 lines, if the program performs every combination of two lines, i.e. comparing line L1 with L2, but also L2 with L1 later on, the number of combinations would be something like:

 

[50!/48!] ~ 2450

 

But if the program knows that if it has compared L1 and L2, not to compare L2 with L1 later on, this number is reduced to:

 

[50!/2(48!)] ~ 1225

 

If my maths is correct! - (stats was never my strong point!)

 

But dividing it up would help somewhat, as the number of calculations would be greatly reduced - but obviously the accuracy of the routine is also impaired somewhat..

 

tough call.

 

I was able to optimize at least that much with this portion of the routine:

 

   Do While objSS.Count > 1
     [color="DarkRed"]Set entPrimary = objSS.Item(0)[/color]
     For i = 1 To objSS.Count - 1
        Set entSecondary = objSS.Item(i)
        varPt = entPrimary.IntersectWith(entSecondary, acExtendNone)
        If UBound(varPt) > 1 Then colPt.Add (varPt)
     Next
[color="darkred"]      Set entObj(0) = entPrimary
     objSS.RemoveItems entObj[/color] [color="Blue"]<<Excludes line just used[/color]
  Loop

 

I trust your math, and I tried to calculate 10000!/9998!. Apparently 10000! is beyond the Double Data Type maximum size 1.79769313486231570E+308, at least according to Excel.

[SEANT]

I guess I could treat it as 10000 x 9999 x 98!, then cancel the 98!. Even excluding the previous line we’re left with 49,995,000 comparisons.

[Lee Mac]

...and I tried to calculate 10000!/9998!. Apparently 10000! is beyond the Double Data Type maximum size 1.79769313486231570E+308, at least according to Excel.

 

I wouldn't be surprised, well by adding that line you can exactly half your calculations - good work.

[David Bethel]

In plain AutoLisp, it might look like this:

 

(defun c:intpl (/ ss sl pl p10 p11 l1 l10 l11 l2 l20 l21 i
                 find pt ip fl)

 (while (not ss)
        (princ "\sSelect The Lines That Intersect:   ")
        (setq ss (ssget '((0 . "LINE")))))

 (while (or (not sl)
            (> (sslength sl) 1))
        (princ "\nSelect The Perpendicular:  ")
        (setq sl (ssget '((0 . "LINE")))))

 (setq pl (ssname sl 0)
       p10 (cdr (assoc 10 (entget pl)))
       p11 (cdr (assoc 11 (entget pl))))

 (and (ssmemb pl ss)
      (princ "\nEliminateing The Perpindicular From The Line Set")
      (ssdel pl ss))

 (while (and ss (> (sslength ss) 1))
        (setq l1 (ssname ss 0)
              l10 (cdr (assoc 10 (entget l1)))
              l11 (cdr (assoc 11 (entget l1)))
              i (sslength ss)
              find nil)
        (while (and (not find)
                     (not (minusp (setq i (1- i)))))
               (setq l2 (ssname ss i)
                     l20 (cdr (assoc 10 (entget l2)))
                     l21 (cdr (assoc 11 (entget l2))))
               (if (setq ip (inters l10 l11 l20 l21))
                   (setq fl (cons ip fl)
                         ss (ssdel l1 ss)
                         ss (ssdel l2 ss)
                         find T))))

  (foreach l fl
     (setq pt (inters p10 p11 l (polar l (+ (angle p10 p11) (* pi 0.5)) 1) nil))
     (entmake (list (cons 0 "LINE")
                    (cons 10 l)
                    (cons 11 pt))))

 (prin1))

I would definitly add some robust error checking and trapping. There are tons of things to go wrong with the selection process. -David

[Lee Mac]

Very good David, I like it.

[priyanka_mehta]

This code works great man!! You are toooooo good.. !! and that too for a beginner like me this code is just lovely..!!

 

There is just one more prob where i need a little help..

 

My baseline is not always a Acadline, it could be a polyline and even arc at some places. Also, is there a way where i can keep on selecting the baseline before i go on selecting the crosses.

 

Please see the attachment for refrence..

 

Thanks again for your help!!

 

Regards,

Priyanka

[CAB]

I have attached a screenshot. It is easy do it manually but not when u have hundereds of such points.

 

Please help,

 

Thanks and Regards,

Priyanka

 

It would be helpful if the POINTS were on some spacific layers and that there is a max distance allowed for the point to the PLINE.

 

Could you post a sample DWG?

[priyanka_mehta]

Hi all,

 

The code works great.. i just need it to work where my baseline is a polyline. I m not able to get where all to modify because it has used startpoint and endpoint of line but my baseline is a polyline..

 

Please help!!

I am so near and yet so far

Drawing1.dwg

[SEANT]

That problem is considerably more complex than was discussed in the first few posts of this thread. Accounting for polylines, which may or may not incorporate arcs, will slow down this already inefficient process.

 

Once again I’m spread a bit too thin to offer any immediate help. If all goes well – and another solution doesn’t show up in the interim – perhaps I can look into it this weekend.

[priyanka_mehta]

Yeah.. tats wat!! I tried using all those codes where you can explode arcs to lines and polylines to lines all at the same time but then it breaks the polyline/arc into such small parts of lines that it becomes extreeeemely difficult to locate the small bit of line which could have a perpendicular line landed upon it.

 

Thanks and Regards,

Priyanka