Lisp to get points at intersection with first encountered objects on 4 directions

June 14, 2023

I would appreciate help with a lisp that will start with a getpoint. From that chosen point send ortho "rays" (0,90,180,270) till it meets the first line or polyline on each direction. Store those intersection points in 4 variables. I want to use them to create linear dimensions between pt1-pt2 and pt3-pt4. Thanks in advance!

example.dwg

Edited June 14, 2023 by Radu Iordache

June 14, 2023

You could use ssget crossing polygon to find lines or polylines in the 4 directions (see Lee Mac ssget functions for help here):

For example this will select all lines within '500' to the right of your point

(setq pt (getpoint "Select Point: "))
(setq offsetpt (mapcar '+ (list 500 0 0) pt))
(setq ss1 (ssget "_C" pt offsetpt '((0 . "*LINE")) ))

Draw a temporary line, from above pt to offsetpt,

(command "line" pt offsetpt "")
(setq ss2 (ssadd (entlast))) ; record this line

(or use entmake or similar to make the line)

and use Lee Macs intersections functions perhaps to find the intersection points - below is the basic function

;;http://lee-mac.com/intersectionfunctions.html
(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
)

and then this one to run it: - I reckon, take away the (defun line and the last ) and it should just run as above

;; Intersections Between Sets  -  Lee Mac
;; Returns a list of all points of intersection between objects in two selection sets.
;; ss1,ss2 - [sel] Selection sets

(defun LM:intersectionsbetweensets ( ss1 ss2 / id1 id2 ob1 ob2 rtn )
    (repeat (setq id1 (sslength ss1))
        (setq ob1 (vlax-ename->vla-object (ssname ss1 (setq id1 (1- id1)))))
        (repeat (setq id2 (sslength ss2))
            (setq ob2 (vlax-ename->vla-object (ssname ss2 (setq id2 (1- id2))))
                  rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn)
            )
        )
    )
    (apply 'append (reverse rtn))
)

and I think this will get you all the intersections off your temporary line. Now just sort them by distance, perhaps using a foreach loop

Delete the temporary line and repeat for the other 4 directions

Will that work, can guide you to making this work if you need it

... something like this for 1 direction but repeated 4 times,

(defun c:testthis ( / pt offsetpt ss lastent id1 id2 ob1 ob2 rtn)

  (setq MyDist 500) ; Max distance from point to consider

  (defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
  )

  (setq pt (getpoint "Select Point: "))
  (setq offsetpt (mapcar '+ (list MyDist 0 0) pt))
  (setq ss1 (ssget "_C" pt offsetpt '((0 . "*LINE")) ))
  (command "line" pt offsetpt "")
  (setq ss2 (ssadd (entlast)))


;;(defun LM:intersectionsbetweensets ( ss1 ss2 / id1 id2 ob1 ob2 rtn )
    (repeat (setq id1 (sslength ss1))
        (setq ob1 (vlax-ename->vla-object (ssname ss1 (setq id1 (1- id1)))))
        (repeat (setq id2 (sslength ss2))
            (setq ob2 (vlax-ename->vla-object (ssname ss2 (setq id2 (1- id2))))
                  rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn)
            )
        )
    )
    (apply 'append (reverse rtn))
;;)
 
  (foreach x rtn
    (if (< (distance pt (car x)) MyDist)
      (progn
        (setq MyDist (distance pt (car x)))
        (setq MyPt x)
      ) ; end progn
    ) ; end if
  ) ; end for each
  
  (entdel (ssname ss2 0)) ; delete temporary line

  (princ MyPt) ; Closest point in direction 1
  (princ)
)

Edited June 14, 2023 by Steven P

June 14, 2023

The thing is called "quickmeasure"...

Here is the link : https://www.cadtutor.net/forum/topic/73952-room-info-table-measure-length-from-objects-to-roomcorner-delta-xdelta-y-and-write-into/#comment-586021

HTH.

M.R.

June 14, 2023

49 minutes ago, marko_ribar said:

The thing is called "quickmeasure"...

Not sure how I missed that one, nice Marko.

OP was asking for co-ordiantes, would that be quick to get from quick measure (yes, I know, I could look but you'd be 10 times quicker!)

June 14, 2023

Here is my attempt.

(defun c:Test (/ clr int sel ent crs lst spc ray pts rtn)
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (and
    (setq clr 0
          int -1
          sel (ssget
                "_X"
                (list '(0 . "*POLYLINE,LINE,ARC") (cons 410 (getvar 'CTAB)))
              )
    )
    (setq crs (getpoint "\nSpecify intersection point : "))
    (while (setq int (1+ int)
                 ent (ssname sel int)
           )
      (setq lst (cons (vlax-ename->vla-object ent) lst))
    )
    (setq spc (vla-get-block
                (vla-get-activelayout (vla-get-document (car lst)))
              )
    )
    (or (not (zerop (getvar 'PDMODE))) (setvar 'PDMODE 3))
    (mapcar
      '(lambda (r)
         (and
           (setq pts nil
                 ray (vlax-invoke spc 'AddRay crs (polar crs (eval r) 1e-8))
           )
           (mapcar '(lambda (o / tch)
                      (and (setq tch
                                  (vlax-invoke ray 'intersectwith o Acextendnone)
                           )
                           (setq pts (cons (vla-get-3dPoints tch) pts))
                      )
                    )
                   lst
           )
         )
         (and ray (vla-delete ray))
         (and pts
              (setq rtn
                     (cons
                       (car
                         (vl-sort
                           (apply 'append pts)
                           (function (lambda (q p)
                                       (< (distance crs q) (distance crs p))
                                     )
                           )
                         )
                       )
                       rtn
                     )
              )
         )
       )
      '(pi 0.0 (* pi 0.5) (* pi 1.5))
    )
  )
  (or (and (= (length rtn) 4)
           (foreach pt (reverse rtn)
             (entmake (list '(0 . "POINT")
                            (cons 10 pt)
                            (cons 62 (setq clr (1+ clr)))
                      )
             )
           )
      )
      (alert
        "Could not find four crossing objects on four sides <!>"
      )
  )
  (princ)
)
(vl-load-com)
;;				;;
(defun vla-get-3dPoints (pts / rtn)
  (while pts
    (setq rtn (cons (list (car pts) (cadr pts) (caddr pts)) rtn)
          pts (cdddr pts)
    )
  )
  rtn
)

June 15, 2023

15 hours ago, Tharwat said:

Here is my attempt.

(defun c:Test (/ clr int sel ent crs lst spc ray pts rtn)
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (and
    (setq clr 0
          int -1
          sel (ssget
                "_X"
                (list '(0 . "*POLYLINE,LINE,ARC") (cons 410 (getvar 'CTAB)))
              )
    )
    (setq crs (getpoint "\nSpecify intersection point : "))
    (while (setq int (1+ int)
                 ent (ssname sel int)
           )
      (setq lst (cons (vlax-ename->vla-object ent) lst))
    )
    (setq spc (vla-get-block
                (vla-get-activelayout (vla-get-document (car lst)))
              )
    )
    (or (not (zerop (getvar 'PDMODE))) (setvar 'PDMODE 3))
    (mapcar
      '(lambda (r)
         (and
           (setq pts nil
                 ray (vlax-invoke spc 'AddRay crs (polar crs (eval r) 1e-8))
           )
           (mapcar '(lambda (o / tch)
                      (and (setq tch
                                  (vlax-invoke ray 'intersectwith o Acextendnone)
                           )
                           (setq pts (cons (vla-get-3dPoints tch) pts))
                      )
                    )
                   lst
           )
         )
         (and ray (vla-delete ray))
         (and pts
              (setq rtn
                     (cons
                       (car
                         (vl-sort
                           (apply 'append pts)
                           (function (lambda (q p)
                                       (< (distance crs q) (distance crs p))
                                     )
                           )
                         )
                       )
                       rtn
                     )
              )
         )
       )
      '(pi 0.0 (* pi 0.5) (* pi 1.5))
    )
  )
  (or (and (= (length rtn) 4)
           (foreach pt (reverse rtn)
             (entmake (list '(0 . "POINT")
                            (cons 10 pt)
                            (cons 62 (setq clr (1+ clr)))
                      )
             )
           )
      )
      (alert
        "Could not find four crossing objects on four sides <!>"
      )
  )
  (princ)
)
(vl-load-com)
;;				;;
(defun vla-get-3dPoints (pts / rtn)
  (while pts
    (setq rtn (cons (list (car pts) (cadr pts) (caddr pts)) rtn)
          pts (cdddr pts)
    )
  )
  rtn
)

That one is giving me an error "; error: AutoCAD.Application: Points are coincident"

June 15, 2023

16 hours ago, Tharwat said:

Here is my attempt.

(defun c:Test (/ clr int sel ent crs lst spc ray pts rtn)
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (and
    (setq clr 0
          int -1
          sel (ssget
                "_X"
                (list '(0 . "*POLYLINE,LINE,ARC") (cons 410 (getvar 'CTAB)))
              )
    )
    (setq crs (getpoint "\nSpecify intersection point : "))
    (while (setq int (1+ int)
                 ent (ssname sel int)
           )
      (setq lst (cons (vlax-ename->vla-object ent) lst))
    )
    (setq spc (vla-get-block
                (vla-get-activelayout (vla-get-document (car lst)))
              )
    )
    (or (not (zerop (getvar 'PDMODE))) (setvar 'PDMODE 3))
    (mapcar
      '(lambda (r)
         (and
           (setq pts nil
                 ray (vlax-invoke spc 'AddRay crs (polar crs (eval r) 1e-8))
           )
           (mapcar '(lambda (o / tch)
                      (and (setq tch
                                  (vlax-invoke ray 'intersectwith o Acextendnone)
                           )
                           (setq pts (cons (vla-get-3dPoints tch) pts))
                      )
                    )
                   lst
           )
         )
         (and ray (vla-delete ray))
         (and pts
              (setq rtn
                     (cons
                       (car
                         (vl-sort
                           (apply 'append pts)
                           (function (lambda (q p)
                                       (< (distance crs q) (distance crs p))
                                     )
                           )
                         )
                       )
                       rtn
                     )
              )
         )
       )
      '(pi 0.0 (* pi 0.5) (* pi 1.5))
    )
  )
  (or (and (= (length rtn) 4)
           (foreach pt (reverse rtn)
             (entmake (list '(0 . "POINT")
                            (cons 10 pt)
                            (cons 62 (setq clr (1+ clr)))
                      )
             )
           )
      )
      (alert
        "Could not find four crossing objects on four sides <!>"
      )
  )
  (princ)
)
(vl-load-com)
;;				;;
(defun vla-get-3dPoints (pts / rtn)
  (while pts
    (setq rtn (cons (list (car pts) (cadr pts) (caddr pts)) rtn)
          pts (cdddr pts)
    )
  )
  rtn
)

Thanks for your time. It's not working in Progecad, gives a bad argument type error.

June 15, 2023

17 hours ago, marko_ribar said:

The thing is called "quickmeasure"...

Here is the link : https://www.cadtutor.net/forum/topic/73952-room-info-table-measure-length-from-objects-to-roomcorner-delta-xdelta-y-and-write-into/#comment-586021

HTH.

M.R.

Thank you, it's not working in Progecad, so I could not test but seems like a nice solution from what I read on the provided link.

June 15, 2023

18 hours ago, Steven P said:

You could use ssget crossing polygon to find lines or polylines in the 4 directions (see Lee Mac ssget functions for help here):

For example this will select all lines within '500' to the right of your point

(setq pt (getpoint "Select Point: "))
(setq offsetpt (mapcar '+ (list 500 0 0) pt))
(setq ss1 (ssget "_C" pt offsetpt '((0 . "*LINE")) ))

Draw a temporary line, from above pt to offsetpt,

(command "line" pt offsetpt "")
(setq ss2 (ssadd (entlast))) ; record this line

(or use entmake or similar to make the line)

and use Lee Macs intersections functions perhaps to find the intersection points - below is the basic function

;;http://lee-mac.com/intersectionfunctions.html
(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
)

and then this one to run it: - I reckon, take away the (defun line and the last ) and it should just run as above

;; Intersections Between Sets  -  Lee Mac
;; Returns a list of all points of intersection between objects in two selection sets.
;; ss1,ss2 - [sel] Selection sets

(defun LM:intersectionsbetweensets ( ss1 ss2 / id1 id2 ob1 ob2 rtn )
    (repeat (setq id1 (sslength ss1))
        (setq ob1 (vlax-ename->vla-object (ssname ss1 (setq id1 (1- id1)))))
        (repeat (setq id2 (sslength ss2))
            (setq ob2 (vlax-ename->vla-object (ssname ss2 (setq id2 (1- id2))))
                  rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn)
            )
        )
    )
    (apply 'append (reverse rtn))
)

and I think this will get you all the intersections off your temporary line. Now just sort them by distance, perhaps using a foreach loop

Delete the temporary line and repeat for the other 4 directions

Will that work, can guide you to making this work if you need it

... something like this for 1 direction but repeated 4 times,

(defun c:testthis ( / pt offsetpt ss lastent id1 id2 ob1 ob2 rtn)

  (setq MyDist 500) ; Max distance from point to consider

  (defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
  )

  (setq pt (getpoint "Select Point: "))
  (setq offsetpt (mapcar '+ (list MyDist 0 0) pt))
  (setq ss1 (ssget "_C" pt offsetpt '((0 . "*LINE")) ))
  (command "line" pt offsetpt "")
  (setq ss2 (ssadd (entlast)))


;;(defun LM:intersectionsbetweensets ( ss1 ss2 / id1 id2 ob1 ob2 rtn )
    (repeat (setq id1 (sslength ss1))
        (setq ob1 (vlax-ename->vla-object (ssname ss1 (setq id1 (1- id1)))))
        (repeat (setq id2 (sslength ss2))
            (setq ob2 (vlax-ename->vla-object (ssname ss2 (setq id2 (1- id2))))
                  rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn)
            )
        )
    )
    (apply 'append (reverse rtn))
;;)
 
  (foreach x rtn
    (if (< (distance pt (car x)) MyDist)
      (progn
        (setq MyDist (distance pt (car x)))
        (setq MyPt x)
      ) ; end progn
    ) ; end if
  ) ; end for each
  
  (entdel (ssname ss2 0)) ; delete temporary line

  (princ MyPt) ; Closest point in direction 1
  (princ)
)

Thank you so much! It works well for 1 direction, gives coordinates of point of intersection located to the right of the chosen point. Now I have to figure out how to modify it to do the same for the other 3 directions.

June 15, 2023

15 minutes ago, Radu Iordache said:

Thanks for your time. It's not working in Progecad, gives a bad argument type error.

I don't know about Progecad but anyway, try to replace the following and let me know:

Replace this:

(setq spc (vla-get-block (vla-get-activelayout (vla-get-document (car lst)))))

With this:

(setq spc (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)))))

June 15, 2023

5 hours ago, Radu Iordache said:

Thank you so much! It works well for 1 direction, gives coordinates of point of intersection located to the right of the chosen point. Now I have to figure out how to modify it to do the same for the other 3 directions.

So to do that I would be tempted to make the main part (which works) into a sub-function and repeat that 4 times

-EDIT-

... something like this.

Also added an error check that there is a line within range (below, MyDist, set to 500 - can be anything you want) - so if your point only has say lines on 3 sides it will record that (the returned list are right, left, top bottom points)

Note that Tharwat is using 'addray instead of temporary lines - lines off to infinity - you could modify this to use them if you want to as well

EDITED TO ADD ORIGINAL SELECTED POINT IN THE OUTPUT LIST AND ORDER IT ACCORDING TO THE SKETCH ABOVE

(defun c:testthis ( / pt offsetpt ss lastent id1 id2 ob1 ob2 rtn)

  (setq MyDist 500) ; Max distance from point to consider

  (defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
  )

  (defun IntPt ( MyDist pt offsetpt / MyPt ss1 ss2 id1 id2 ob1 ob2 rtn )
    (if (setq ss1 (ssget "_C" pt offsetpt '((0 . "*LINE")) ))
    (progn
      (command "line" pt offsetpt "")
      (setq ss2 (ssadd (entlast)))

;;(defun LM:intersectionsbetweensets ( ss1 ss2 / id1 id2 ob1 ob2 rtn )
      (repeat (setq id1 (sslength ss1))
        (setq ob1 (vlax-ename->vla-object (ssname ss1 (setq id1 (1- id1)))))
        (repeat (setq id2 (sslength ss2))
            (setq ob2 (vlax-ename->vla-object (ssname ss2 (setq id2 (1- id2))))
                  rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn)
            )
        )
      )
      (apply 'append (reverse rtn))
;;)
 
      (foreach x rtn
        (if (< (distance pt (car x)) MyDist)
          (progn
            (setq MyDist (distance pt (car x)))
            (setq MyPt x)
          ) ; end progn
        ) ; end if
      ) ; end for each
  
      (entdel (ssname ss2 0)) ; delete temporary line
     ) ; end progn
     (progn
       (setq MyPt (list "Line out of range") )
     ) ; end progn
     ) end if ss1
      MyPt
  ) ; end defun

;;  (setq MyPt (list)) ; empty list
  (setq pt (getpoint "Select Point: "))
  (setq MyPt pt)
                        
                        
;;4 repeats...
  (setq offsetpt (mapcar '+ (list (- MyDist) 0 0) pt))
  (setq MyPt (append MyPt (IntPt MyDist pt offsetpt ) ))
                       
  (setq offsetpt (mapcar '+ (list MyDist 0 0) pt))
  (setq MyPt (append MyPt (IntPt MyDist pt offsetpt ) ))

  (setq offsetpt (mapcar '+ (list 0 MyDist 0) pt))
  (setq MyPt (append MyPt (IntPt MyDist pt offsetpt ) ))

  (setq offsetpt (mapcar '+ (list 0 (- MyDist) 0) pt))
  (setq MyPt (append MyPt (IntPt MyDist pt offsetpt ) ))

  (princ MyPt)
  (princ)
)

Edited June 15, 2023 by Steven P

June 15, 2023

2 hours ago, Tharwat said:
I don't know about Progecad but anyway, try to replace the following and let me know:

Replace this:
(setq spc (vla-get-block (vla-get-activelayout (vla-get-document (car lst)))))
With this:
(setq spc (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)))))

It is still giving me the same error in AutoCAD

June 15, 2023

11 minutes ago, Steven P said:

It is still giving me the same error in AutoCAD

My reply was forwarded to the OP and not to you.

June 15, 2023

17 hours ago, Tharwat said:

My reply was forwarded to the OP and not to you.

That's fine, however I was reporting a problem I found in the LISP which may be relevant to others who follow this thread afterwards, might be something in there that is causing the problem in my CAD and in the OPs ?

EDIT....

For anyone reading in the future, a couple of minutes of looking and I think this is what you wanted to use - works on my CAD now.... I guess another few minutes will give me a list of ProCAD VLA- commands that can be used just to confirm where that is causing an error in the OPs CAD system, then job done for the OP with your idea too?

ray (vlax-invoke spc 'AddRay crs (polar crs (eval r) 1e8))

Edited June 16, 2023 by Steven P

June 15, 2023

2 hours ago, Steven P said:

So to do that I would be tempted to make the main part (which works) into a sub-function and repeat that 4 times

-EDIT-

... something like this.

Also added an error check that there is a line within range (below, MyDist, set to 500 - can be anything you want) - so if your point only has say lines on 3 sides it will record that (the returned list are right, left, top bottom points)

Note that Tharwat is using 'addray instead of temporary lines - lines off to infinity - you could modify this to use them if you want to as well

(defun c:testthis ( / pt offsetpt ss lastent id1 id2 ob1 ob2 rtn)

  (setq MyDist 500) ; Max distance from point to consider

  (defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
  )

  (defun IntPt ( MyDist pt offsetpt / MyPt ss1 ss2 id1 id2 ob1 ob2 rtn )
    (if (setq ss1 (ssget "_C" pt offsetpt '((0 . "*LINE")) ))
    (progn
      (command "line" pt offsetpt "")
      (setq ss2 (ssadd (entlast)))

;;(defun LM:intersectionsbetweensets ( ss1 ss2 / id1 id2 ob1 ob2 rtn )
      (repeat (setq id1 (sslength ss1))
        (setq ob1 (vlax-ename->vla-object (ssname ss1 (setq id1 (1- id1)))))
        (repeat (setq id2 (sslength ss2))
            (setq ob2 (vlax-ename->vla-object (ssname ss2 (setq id2 (1- id2))))
                  rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn)
            )
        )
      )
      (apply 'append (reverse rtn))
;;)
 
      (foreach x rtn
        (if (< (distance pt (car x)) MyDist)
          (progn
            (setq MyDist (distance pt (car x)))
            (setq MyPt x)
          ) ; end progn
        ) ; end if
      ) ; end for each
  
      (entdel (ssname ss2 0)) ; delete temporary line
     ) ; end progn
     (progn
       (setq MyPt (list "Line out of range") )
     ) ; end progn
     ) end if ss1
      MyPt
  ) ; end defun

  (setq MyPt (list)) ; empty list
  (setq pt (getpoint "Select Point: "))

;;4 repeats...
  (setq offsetpt (mapcar '+ (list MyDist 0 0) pt))
  (setq MyPt (append MyPt (IntPt MyDist pt offsetpt ) ))

  (setq offsetpt (mapcar '+ (list (- MyDist) 0 0) pt))
  (setq MyPt (append MyPt (IntPt MyDist pt offsetpt ) ))

  (setq offsetpt (mapcar '+ (list 0 MyDist 0) pt))
  (setq MyPt (append MyPt (IntPt MyDist pt offsetpt ) ))

  (setq offsetpt (mapcar '+ (list 0 (- MyDist) 0) pt))
  (setq MyPt (append MyPt (IntPt MyDist pt offsetpt ) ))

  (princ MyPt)
  (princ)
)

Thanks! It works for all directions, gives coordinates for all intersections. BUT, because of my very little to no knowledge, I cannot understand which point is which variable. I want to make linear dimension using those (one horizontal or one vertical) so I need to know which is which. As I see, now all the points are stored in one variable (MyPt).

June 15, 2023

4 hours ago, Tharwat said:
I don't know about Progecad but anyway, try to replace the following and let me know:

Replace this:
(setq spc (vla-get-block (vla-get-activelayout (vla-get-document (car lst)))))
With this:
(setq spc (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)))))

Unfortunately it's the same. Progecad works with 90% of lisps, however not with all. Thanks a lot for your time!

June 15, 2023

31 minutes ago, Radu Iordache said:

Thanks! It works for all directions, gives coordinates for all intersections. BUT, because of my very little to no knowledge, I cannot understand which point is which variable. I want to make linear dimension using those (one horizontal or one vertical) so I need to know which is which. As I see, now all the points are stored in one variable (MyPt).

Note: I have just edited the code above to add the selected point to the list and order it according to your sketch

No problem for your comment and you are right the output is a single list, MyPt with 5 lists within that (the points coordinates). If you want to split them out then the easiest way (for understanding) to do this is with the nth function, for example (nth 0 MyPt) will give the first coordinates in my list, (nth 3 MyPt) will give the 4th in the list (LISPs tend to start counting at 0:- 0, 1, 2, 3, 4),

In my output list now,

nth 0: Selected point coordinates

nth 1: Point to left (your Pt1)

nth 2 Point to right (your Pt2)

nth 3: Point above (your Pt3)

nth 4: Point below (your Pt4)

Might be that you want to do more with this - you can make up another LISP and call this one using (c:testthis) in the code, or better perhaps (setq IntersPts (c:testthis)), intersPts in your next LISP will be the coordinates list returned above which you might then use to make a linear dimension as required. If you need anything for the next step then just say, or have a go and ask for advice

June 15, 2023

16 minutes ago, Steven P said:

Note: I have just edited the code above to add the selected point to the list and order it according to your sketch

No problem for your comment and you are right the output is a single list, MyPt with 5 lists within that (the points coordinates). If you want to split them out then the easiest way (for understanding) to do this is with the nth function, for example (nth 0 MyPt) will give the first coordinates in my list, (nth 3 MyPt) will give the 4th in the list (LISPs tend to start counting at 0:- 0, 1, 2, 3, 4),

In my output list now,

nth 0: Selected point coordinates

nth 1: Point to left (your Pt1)

nth 2 Point to right (your Pt2)

nth 3: Point above (your Pt3)

nth 4: Point below (your Pt4)

Might be that you want to do more with this - you can make up another LISP and call this one using (c:testthis) in the code, or better perhaps (setq IntersPts (c:testthis)), intersPts in your next LISP will be the coordinates list returned above which you might then use to make a linear dimension as required. If you need anything for the next step then just say, or have a go and ask for advice

Thanks, worked great with nth! Very nice work, will help me a lot, I really appreciate it!

June 15, 2023

No problem, it was an interesting one to think about.

June 15, 2023

1 hour ago, Radu Iordache said:

Unfortunately it's the same. Progecad works with 90% of lisps, however not with all. Thanks a lot for your time!

Yes for sure the problem with these duplicate programs that mimic AutoCAD and most of them lack of the entire functions that CAD uses.

Sign In

Lisp to get points at intersection with first encountered objects on 4 directions

Recommended Posts

Radu Iordache

Steven P

marko_ribar

Steven P

Tharwat

Steven P

Radu Iordache

Radu Iordache

Radu Iordache

Tharwat

Steven P

Steven P

Tharwat

Steven P

Radu Iordache

Radu Iordache

Steven P

Radu Iordache

Steven P

Tharwat

Join the conversation

Tutorials

Forums

Activity