Create Perpendicular Line at every intersection point

[Lee Mac]

Its a shame because this problem would be a much much simpler one if the intersecting crosses were instead blocks with a base point at the intersection., then with a LISP one could just scoop up all the crosses (blocks) and use a simple "vlax-curve-getClosestPointTo" function and draw the line.

 

The fact that the lines are not blocks means the LISP has to go through the rigmarole of determining which lines intersect with which... a very tedious operation even for a computer...

[David Bethel]

Lee,

 

That is easily done. If it has to be an INSERT, in the routine that I wrote:

               (if (setq ip (inters l10 l11 l20 l21))
                   (setq fl (cons ip fl)
                         ss (ssdel l1 ss)
                         ss (ssdel l2 ss)
                         find T)
;|ADD An entmake call here to make a BLOCK and INSERT
You have the intersection point ( ip ) and the 2 line entities' definition  ( l1 l2 )
You could use incremental or anonymous block names and then add them to a PICKSET|;
)))

The list fl contains the intersection points. -David

[Lee Mac]

Nice one David, I'll see what I can do

[priyanka_mehta]

Actually, I am quite new to AutoCAD, so I really dont know about "vlax-curve-getClosestPointTo".

Please, do let me know how could these be used, because not for this project, but for my next project I might have to do a similar thing,

where I would have blocks like i have in my attached Drawing2.dwg.

 

There, I would have to create such perpendicular lines, as well as find the ID(coordinates) at the base point (which comes out to be the intersection of plus sign when you explode the block).

 

So, please let me know about creating a perpendicular line from blocks, coz its gonna be great if i can submit both my projects together !!

Drawing2.dwg

[Lee Mac]

Yes, I could make you a LISP to do just a thing - those Blocks are what I was talking about - with the base point at the intersection of the crosses.

[Lee Mac]

This should work for now:

 

(defun c:blkdis    (/ cCurve cBlock index ent dPt1 dPt2)
   (setvar "cmdecho" 0)
   (vl-load-com)
   (if (and (setq cCurve (car (entsel "\nSelect Main Curve > ")))
        (member (cdr (assoc 0 (entget cCurve)))
           '("LINE" "POLYLINE" "LWPOLYLINE" "SPLINE" "ARC" "CIRCLE" "ELLIPSE")))
      (progn
          (while (setq cBlock (ssget '((0 . "INSERT"))))
             (setq index (sslength cBlock))
             (while (not (minusp (setq index (1- index))))
             (setq    ent  (entget (ssname cBlock index))
               dPt1 (cdr (assoc 10 ent))
               dPt2 (vlax-curve-getClosestPointTo cCurve dPt1))
             (command "_line" dPt1 dPt2 ""))))
      (princ "\n<!> Empty selection or this isn't a Curve (line, polyline, etc.) <!> "))
   (setvar "cmdecho" 1)
   (princ)) 

 

User Selects the Curve that he/she wants perp. lines joined to - then selects blocks.

 

Are all the blocks called "block2"?

[Lee Mac]

If they are all called "block2", then:

 

(defun c:blkdis    (/ cCurve cBlock index ent dPt1 dPt2)
   (setvar "cmdecho" 0)
   (vl-load-com)
   (if    (and (setq cCurve (car (entsel "\nSelect curve to measure > ")))
        (member (cdr (assoc 0 (entget cCurve)))
            '("LINE" "POLYLINE" "LWPOLYLINE" "SPLINE" "ARC" "CIRCLE" "ELLIPSE")))
   (progn
       (setq cBlock (ssget "X" (list (cons 0 "INSERT") (cons 2 "block2")))
         index     (sslength cBlock))
       (while (not (minusp (setq index (1- index))))
       (setq ent  (entget (ssname cBlock index))
             dPt1 (cdr (assoc 10 ent))
             dPt2 (vlax-curve-getClosestPointTo cCurve dPt1))
       (command "_line" dPt1 dPt2 "")))
   (princ "\n<!> Empty selection or this isn't a Curve (line, polyline, etc.) <!> "))
   (setvar "cmdecho" 1)
   (princ))

[Lee Mac]

Obviously my last posted LISP assumes a lot.

 

It assumes that all the blocks you want with lines are named "block2" (as in your posted example drawing).

 

It assumes all the blocks (called "block2") are attached to the same polyline (selected at the start of the routine).

 

This LISP could be revised in many ways - if all the blocks are put on a new layer then the filter list in the ssget function could be modified accordingly, or you could just settle for selecting the blocks that you would like lines joined to.

 

I leave the decision in your hands

[CAB]

You can give this a test drive.

No warranty

 

;;  CAB 01.15.09
;;  Create perp lines from selected crosses to centerline
;;  Crosses & centerline must be line or Lwpolyline objects
(defun c:CLX (/ ssx ssc lst obj intpts ssxl masterlist clObj pt px)
 (vl-load-com)
 (prompt "\nSelect the crosses.")
 (setq ssx (ssget '((0 . "LINE,LWPOLYLINE"))))
 (prompt "\nSelect the centerline.")
 (setq ssc (ssget "_+.:E:S" '((0 . "LINE,LWPOLYLINE"))))
 (if (and ssx ssc)
   (progn
     ;;  get cross points
     (foreach obj (setq ssxl (ssget->vla-list ssx)) ; check each object in ss2brk
       (setq lst nil)
       ;; check for break pts with other objects in ss2brkwith
       (foreach intobj ssxl
         (if (and (not (equal obj intobj))
                  (setq intpts (get_interpts obj intobj))
                  (= (length intpts) 3) ; allow only one intersect 
             )
           (setq lst (append (list->3pair intpts) lst)) ; entity w/ break points
         )
       )
       (if lst
         (setq masterlist (append masterlist lst))
       )
     )

     (setq clObj (vlax-ename->vla-object (ssname ssc 0)))
     (if masterlist ; make perp lines
       (progn
         (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
         (vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object)))
         (foreach pt masterlist
           (if (setq px (vlax-curve-getClosestPointTo clObj pt))
             (entmake (list (cons 0 "LINE")
                            (cons 6 "BYLAYER")
                            ;;(cons 8 "0") 
                            (cons 10 pt)
                            (cons 11 px)
                            ;;(cons 39 0.0) 
                            (cons 62 256)
                            (cons 210 (list 0.0 0.0 1.0))
                      )
             )
           )
         )
         (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
       )
     )
   )
 )

 (princ)
)

;;=====================================
;;  return a list of intersect points  
;;=====================================
(defun get_interpts (obj1 obj2 / iplist)
 (if (not (vl-catch-all-error-p
            (setq iplist (vl-catch-all-apply
                           'vlax-safearray->list
                           (list
                             (vlax-variant-value
                               (vla-intersectwith obj1 obj2 acextendnone)
                             )
                           )
                         )
            )
          )
     )
   iplist
 )
)

(defun ssget->vla-list (ss / i ename allobj) ; this is faster, changed in ver 1.7
 (setq i -1)
 (while (setq ename (ssname ss (setq i (1+ i))))
   (setq allobj (cons (vlax-ename->vla-object ename) allobj))
 )
 allobj
)

;;  return a list of lists grouped by 3 from a flat list
(defun list->3pair (old / new)
 (while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
              old (cdddr old)
        )
 )
 (reverse new)
)

[Lee Mac]

sget "_+.:E:S" '((0 . "LINE,LWPOLYLINE")

 

CAB, I notice that you use this within your code.

 

Not that I understand the majority of the code - this caught my eye.

 

When you put "_+.:E:S"

 

does this mean:

 

Allow single entity only (:S)

 

Only allo pickbox (:E)

 

combined?

 

Is that how you combine these things - with a "_+." ??

[CAB]

It breaks down to this:

(setq ssent (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))

 

_ Support for other languages

+. Use autocad built in commands, + is needed for syntax

:E Everything in aperture, Everything within the cursor's object selection pickbox.

:S Force single object selection only

 

'((0 . "LWPOLYLINE")) Only get objects with DXF code zero equal to "LWPOLYLINE"

in other words only LWpolyline objects

[Lee Mac]

So would this work?

 

ssget "_+.W:S" etc etc

[CAB]

No, W is used with no user input while :S is used with use input.

[SEANT]

With regard to using the “closest point”; it is quite probably the OP’s ultimate goal but will not necessarily give a perpendicular connection (see example).

 

Priyanka, could you give a bit more information to help broaden the scope of this process.

ClosestPoint.dwg

[CAB]

Very good point Seant. Looking at your example DWG there will be points that don't have a segment that it is perpendicular too.

Also the other example has two segments that it is perpendicular too.

So I guess the rules could boil down to this:

 

Use the closest perpendicular point else

If no perpendicular point then closest point or No point.

 

Obviously I took the easy way out.

[Lee Mac]

Good point Seant - I just used Closest Point, and if this happens to be perpendicular, then so be it.

 

Obviously my LISPs assume blocks - as stated in the posted example.

[CAB]

There is a relatively easy solution. Using the Explode Method to create a copy of the pline only in its parts.

Then using vlax-curve-getClosestPointTo to get points for each segment. If the new point is not an end point

then it is a perpendicular point. Get the one with the shortest distance & you have a winner.

If no perpendicular point the use or not the closest point per the OP.

[SEANT]

There is a relatively easy solution. Using the Explode Method to create a copy of the pline only in its parts.

Then using vlax-curve-getClosestPointTo to get points for each segment. If the new point is not an end point

then it is a perpendicular point. Get the one with the shortest distance & you have a winner.

If no perpendicular point the use or not the closest point per the OP.

 

That sounds like a good game plan. One stumbling block, however, is the original request was for a VBA routine and, as you may be aware, VBA is a little deficient in the “getClosestPointTo” methodology (AutoCAD mechanical notwithstanding).

 

There may be a suitable process with VBA but it would require a fair bit of testing. (V)Lisp, ARX or .NET certainly has a head start for this type of procedure.

[Lee Mac]

Why is this not sufficient.?

Lines to Blocks.zip

[CAB]

Lisp is all i know.

This is version 2, still need refinement.

;;  CAB Rev2 01.15.16
;;  Create perp lines from selected crosses to centerline
;;  Crosses & centerline must be line or Lwpolyline objects
;; 
(defun c:CLX (/ ssx ssc lst obj intpts ssxl masterlist clEnt pt px)
 (vl-load-com)
 (prompt "\nSelect the crosses.")
 (setq ssx (ssget '((0 . "LINE,LWPOLYLINE"))))
 (prompt "\nSelect the centerline.")
 (setq ssc (ssget "_+.:E:S" '((0 . "LINE,LWPOLYLINE"))))
 (if (and ssx ssc)
   (progn
     ;;  get cross points
     (setq ssxl (ssget->vla-list ssx))
     (while (setq obj (car ssxl))  ; check each object in ss2brk
       (setq ssxl (cdr ssxl)
             lst  nil)
       ;; check for break pts with other objects in ss2brkwith
       (foreach intobj ssxl
         (if (and (not (equal obj intobj))
                  (setq intpts (get_interpts obj intobj))
                  (= (length intpts) 3) ; allow only one intersect 
             )
           (setq lst (append (list->3pair intpts) lst)) ; entity w/ break points
         )
       )
       (setq ssxl (vl-remove obj ssxl))
       (if (and lst (not (vl-position (car lst) masterlist)))
         (setq masterlist (append masterlist lst))
       )
     )

     (setq clEnts
       (mapcar
         'vlax-vla-object->ename
             (vlax-invoke (vlax-ename->vla-object (ssname ssc 0)) 'Explode))
     )
     
     (if masterlist ; make perp lines
       (progn
         (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
         (vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object)))
         (foreach pt masterlist
           (if (setq px (getClosestPointTo clEnts pt))
             (entmake (list (cons 0 "LINE")
                            (cons 6 "BYLAYER")
                            ;;(cons 8 "0") 
                            (cons 10 pt)
                            (cons 11 px)
                            ;;(cons 39 0.0) 
                            (cons 62 256)
                            (cons 210 (list 0.0 0.0 1.0))
                      )
             )
           )
         )
         (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
       )
     )
     (mapcar '(lambda (x) (vla-delete (vlax-ename->vla-object x))) clEnts) ; remove the segments
   )
 )

 (princ)
)

;;=====================================
;;  return a list of intersect points  
;;=====================================
(defun get_interpts (obj1 obj2 / iplist)
 (if (not (vl-catch-all-error-p
            (setq iplist (vl-catch-all-apply
                           'vlax-safearray->list
                           (list
                             (vlax-variant-value
                               (vla-intersectwith obj1 obj2 acextendnone)
                             )
                           )
                         )
            )
          )
     )
   iplist
 )
)

(defun ssget->vla-list (ss / i ename allobj) ; this is faster, changed in ver 1.7
 (setq i -1)
 (while (setq ename (ssname ss (setq i (1+ i))))
   (setq allobj (cons (vlax-ename->vla-object ename) allobj))
 )
 allobj
)

;;  return a list of lists grouped by 3 from a flat list
(defun list->3pair (old / new)
 (while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
              old (cdddr old)
        )
 )
 (reverse new)
)


;;  return shortest perpendicular point else closest point to
(defun getClosestPointTo (Ents pt / ent clspt endpts perpts result dist)
 (foreach ent Ents
   (if (or (< (distance (setq clspt (vlax-curve-getclosestpointto ent pt))
                        (vlax-curve-getstartpoint ent)) 0.0001)
           (< (distance clspt (vlax-curve-getendpoint ent)) 0.0001)
       )
     (setq endpts (cons clspt endpts)) ; no perpendicular point
     (setq perpts (cons clspt perpts)) ; else got a perpendicular point
   )
 )
 (cond
   (perpts
    (mapcar '(lambda(x / tmp) (cond
                                ((null dist)(setq dist (distance pt x) result x))
                                ((< (setq tmp (distance pt x)) dist)
                                  (setq dist tmp result x))))
            perpts)
    )
   (endpts
    (mapcar '(lambda(x / tmp) (cond
                                ((null dist)(setq dist (distance pt x) result x))
                                ((< (setq tmp (distance pt x)) dist)
                                  (setq dist tmp result x))))
            endpts)
    )
 )
 result
)