Nearest point form mtext to pline, but horizontaly

September 23, 2022

Hi

I have tried various routing programs with complicated route but for now its hard to me to figure it out even with your help.
Thought I'd start with something easier. Suppose we have a lot of vertical or oblique polylines, including mtext. I would like lisp to find the intersection with the nearest left and right polylines but only on a horizontal line and name these points as follows "mtext + l1" for left pline and "mtext + r1" for right.
Any help is nice to see, especially with the search for the closest points horizontally.
Below is a description of the problem in the pictures.

Starting situation:

Created points in red after running lisp:

September 23, 2022

Draw a horizontal XLine, see where it intersects with the polylines, now look for the closest X-value of those intersect points with the polylines.

Delete the temporary XLINE.

(vl-load-com)

;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/
;; draw a XLINE
(defun drawxLine (pt vec)
 (entmakex (list (cons 0 "XLINE")
                 (cons 100 "AcDbEntity")
                 (cons 100 "AcDbXline")
                 (cons 10 pt)
                 (cons 11 vec))))
;; draw MText				 
(defun drawM-Text (pt str)
 (entmakex (list (cons 0 "MTEXT")         
                 (cons 100 "AcDbEntity")
                 (cons 100 "AcDbMText")
                 (cons 10 pt)
                 (cons 1 str))))
				 
(defun drawLine (p1 p2)
 (entmakex (list (cons 0 "LINE")
                 (cons 10 p1)
                 (cons 11 p2))))
				 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; Intersections  -  Lee Mac
;; http://www.lee-mac.com/intersectionfunctions.html
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method
        ;; acextendnone 	      Do not extend either object
        ;; acextendthisentity 	Extend obj1 to meet obj2
        ;; acextendotherentity 	Extend obj2 to meet obj1
        ;; acextendboth 	      Extend both objects
(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 c:npp ( / txt plines xline pt obj2 ins insx insx_sorted xl xr str)

	(princ "\nSelect ploylines")
	(setq plines (ssget (list (cons 0 "LINE,LWPOLYLINE,POLYLINE"))))

	(setq txt (entsel "\nSelect Text object: "))
	(setq str (cdr (assoc 1 (entget (car txt)))))
	(setq pt  (cdr (assoc 10 (entget (car txt)))))
	
	;; draw a horizontal XLINE
	(setq xline (drawxLine pt (list 1.0 0.0)))  ;; (list 1.0 0.0) draws to the right, (list 0.0 1.0) draws up thus vertical, ...
	
	;; now look for intersect points of the XLINE with the polylines
	(setq insx (list))		;; list of intersect points.  Only the X value.
	(setq i 0)
	(repeat (sslength plines)
		(setq obj2 (ssname plines i))
		(setq ins (LM:intersections (vlax-ename->vla-object xline) (vlax-ename->vla-object obj2) acextendnone))
		;; if there are intersect points, add the x-value to the list
		(foreach a ins
			(setq insx (append insx (list (nth 0 a) )))
		)
		(setq i (+ i 1))
	)
	
	;; we no longer need the XLINE, we delete it
	(entdel xline)
	
	;; sort the insx values from left to right
	(setq insx_sorted (vl-sort insx '<))
	
	;;(princ insx_sorted)
	;; now we go looking for xl (left of the text) and xr (right of the text)
	(setq xl nil)
	(setq xr nil)
	
	(foreach a insx_sorted
		(if (< a (nth 0 pt))	;; as long as the insert point is to the left, we'll replace xl
			(setq xl a)
		)
		(if (and (not xr) (> a (nth 0 pt)))	;; the first insert point the right is the closest one
			(setq xr a)
		)
	)
	
	;;(princ "\nLeft: ")
	;;(princ xl)
	;;(princ " - Right: ")
	;;(princ xr)
	;;(princ )
	
	;; draw line
	;; we add the Y value of the Text object to get a point
	(drawLine (list xl (nth 1 pt)) (list xr (nth 1 pt)))
	;; draw Mtexts
	(drawM-Text (list xl (nth 1 pt)) (strcat str " l1"))	
	(drawM-Text (list xr (nth 1 pt)) (strcat str " r1"))
	
)

Edited September 23, 2022 by Emmanuel Delay

September 23, 2022

Here is my program to achieve your goal after you select just a text.

(defun c:Test (/ *error* zom str loc dis ins get tmp int sel ent cls del cad zom end )
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (defun *error* (msg)
    (and del (vla-delete del))
    (and zom cad (vla-ZoomPrevious cad))
    (and msg (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\nError => " msg)))
    (princ)
    )
  (and (cond ((= 4 (logand 4 (cdr (assoc 70 (setq get (entget (tblobjname "LAYER" (getvar 'CLAYER))))))))
              (alert "Current layer is locked. Unlock it and try again <!>")
              )
             ((minusp (cdr (assoc 62 get)))
              (alert "Current layer is off. Turn it on and try again <!>")
              )
             (t get)
             )
       (setq str (car (entsel "\nSelect text to search for crossed polyline on Left & Right : ")))
       (or (wcmatch (cdr (assoc 0 (setq get (entget str)))) "TEXT,MTEXT")
           (alert "Invalid object selected. Try again")
           )
       (setq ins (trans (polar (cdr (assoc 10 get)) (* pi 1.5) (/ (cdr (assoc 40 get)) 2.)) 1 0)
             cad (vlax-get-acad-object)
             )
       (or (mapcar '(lambda ( rot pos )
                      (setq dis 1e6
                            end (polar ins rot dis)
                            )
                      (and (setq del (vlax-ename->vla-object (entmakex (list '(0 . "LINE") (cons 10 ins) (cons 11 end)))))
                           (setq zom (or (vla-zoomExtents cad) t))
                           (setq int -1 sel (ssget "_F" (list ins end) '((0 . "*POLYLINE"))))
                           (while (setq int (1+ int) ent (ssname sel int))
                             (and (setq cls (vlax-invoke del 'IntersectWith (vlax-ename->vla-object ent) AcExtendNone))
                                  (if (= 3 (length cls))
                                    (or (< dis (setq tmp (distance ins cls)))
                                        (setq dis tmp loc cls))
                                    (foreach pt (_pair:coordinates cls)
                                      (or (< dis (setq tmp (distance ins pt)))
                                          (setq dis tmp loc pt))
                                      )
                                    )
                                  )
                             )
                           (entmake (list '(0 . "TEXT") (cons 10 loc) (cons 1 (strcat (cdr (assoc 1 get)) "-" pos "1")) (assoc 40 get)
                                           (assoc 7 get) (cons 11 loc) '(71 . 0) '(72 . 1) '(73 . 2)))
                           )
                      (or (setq del (vla-delete del))
                          (setq zom (vla-ZoomPrevious cad))
                          )
                      )
                   '(0.0 3.14159)
                   '("r" "l")
                   )
           )
       )
  (princ)
  ) (vl-load-com)
;;				;;
(defun _pair:coordinates ( l )
  ;; Tharwat - Date: 10.Jun.2015	;;
  (if l (cons (list (car l) (cadr l) (caddr l))
              (_pair:coordinates (cdddr l))
              )
    )
  )

September 28, 2022

Here's another approach without the need to draw any additional entities and using IntersectWith. Curve detection is limited to curves that are visible on screen at the time of selecting the text, to prevent "accidental" unintended text placements:

(defun c:foo ( / a c enx f l pt px r s ss txt x z)
    (while
        (progn
            (setvar "errno" 0)
            (initget "Exit")
            (setq txt (entsel "\nSelect text [Exit] <exit>: "))
            (cond
                (   (= (getvar "errno") 7) (princ "\nNothing selected."))
                (   (member txt '("Exit" nil)) nil)
                (   (not (wcmatch (cdr (assoc 0 (setq txt (car txt) enx (append (entget txt) '((62 . 1)))))) "TEXT,MTEXT"))
                    (princ "\nObject is not a text.")
                )
                (   t
                    (if 
                        (eq (cdr (assoc 0 enx)) "TEXT")
                        (if 
                            (vl-every 'zerop (mapcar '(lambda (x) (cdr (assoc x enx))) '(71 72 73)))
                            (setq pt (cdr (assoc 10 enx)) z t)
                            (setq pt (cdr (assoc 11 enx)))
                        )
                        (setq pt (cdr (assoc 10 enx)))
                    )
                    (setq 
                        s (* (apply '/ (getvar 'screensize)) (getvar 'viewsize) 0.5)
                        f (list (car (getvar 'viewctr)) (cadr pt) (caddr pt))
                    )
                    (if 
                        (setq ss 
                            (ssget "_F" 
                                (list (mapcar '- f (list s 0.0 0.0)) (mapcar '+ f (list s 0.0 0.0)))
                                '((0 . "LINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE"))
                            )
                        )
                        (progn
                            (foreach x (ssnamex ss)
                                (foreach y (vl-remove-if-not 'listp x)
                                    (if 
                                        (equal (cadr y) (setq c (vlax-curve-getclosestpointto (cadr x) (cadr y))) 1)
                                        (if 
                                            (minusp (setq px (- (car c) (car pt))))
                                            (if (or (not l) (> px l)) (setq l px))
                                            (if (or (not r) (< px r)) (setq r px))
                                        )
                                    )
                                )
                            )
                            (foreach x (list (cons l "-l1") (cons r "-r1"))
                                (if (car x)
                                    (entmake
                                        (mapcar
                                            '(lambda (a)
                                                (cond
                                                    (   (= (car a) 1) (cons 1 (strcat (cdr a) (cdr x))))
                                                    (   (= (car a) 10) (cons 10 (mapcar '+ pt (list (car x) 0.0 0.0))))
                                                    (   (= (car a) 11) (if z a (cons 11 (mapcar '+ pt (list (car x) 0.0 0.0)))))
                                                    (   a   )
                                                )
                                            )
                                            enx
                                        )
                                    )
                                )
                            )
                        )
                        (not (setq l nil r nil z nil))
                    )
                )
            )
        )
    )
    (princ)
)

However, if you do intend on processing all curves throughout the drawing, you may use the below instead:

(defun c:foo ( / a c enx l pt px r ss txt x z)
    (while
        (progn
            (setvar "errno" 0)
            (initget "Exit")
            (setq txt (entsel "\nSelect text [Exit] <exit>: "))
            (cond
                (   (= (getvar "errno") 7) (princ "\nNothing selected."))
                (   (member txt '("Exit" nil)) nil)
                (   (not (wcmatch (cdr (assoc 0 (setq txt (car txt) enx (append (entget txt) '((62 . 1)))))) "TEXT,MTEXT"))
                    (princ "\nObject is not a text.")
                )
                (   t
                    (if 
                        (eq (cdr (assoc 0 enx)) "TEXT")
                        (if 
                            (vl-every 'zerop (mapcar '(lambda (x) (cdr (assoc x enx))) '(71 72 73)))
                            (setq pt (cdr (assoc 10 enx)) z t)
                            (setq pt (cdr (assoc 11 enx)))
                        )
                        (setq pt (cdr (assoc 10 enx)))
                    )
                    (if 
                        (setq ss 
                            (ssget "_F" 
                                (list 
                                    (append (list (car (getvar 'extmin))) (cdr pt))
                                    (append (list (car (getvar 'extmax))) (cdr pt))
                                )
                                '((0 . "LINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE"))
                            )
                        )
                        (progn
                            (foreach x (ssnamex ss)
                                (foreach y (vl-remove-if-not 'listp x)
                                    (if 
                                        (equal (cadr y) (setq c (vlax-curve-getclosestpointto (cadr x) (cadr y))) 1)
                                        (if 
                                            (minusp (setq px (- (car c) (car pt))))
                                            (if (or (not l) (> px l)) (setq l px))
                                            (if (or (not r) (< px r)) (setq r px))
                                        )
                                    )
                                )
                            )
                            (foreach x (list (cons l "-l1") (cons r "-r1"))
                                (if (car x)
                                    (entmake
                                        (mapcar
                                            '(lambda (a)
                                                (cond
                                                    (   (= (car a) 1) (cons 1 (strcat (cdr a) (cdr x))))
                                                    (   (= (car a) 10) (cons 10 (mapcar '+ pt (list (car x) 0.0 0.0))))
                                                    (   (= (car a) 11) (if z a (cons 11 (mapcar '+ pt (list (car x) 0.0 0.0)))))
                                                    (   a   )
                                                )
                                            )
                                            enx
                                        )
                                    )
                                )
                            )
                        )
                        (not (setq l nil r nil z nil))
                    )
                )
            )
        )
    )
    (princ)
)

Edited September 28, 2022 by Jonathan Handojo

September 28, 2022

Look at function :

(vlax-curve-getclosestpointtoprojection)

and study it...

September 28, 2022

59 minutes ago, marko_ribar said:

Look at function :

(vlax-curve-getclosestpointtoprojection)

and study it...

Ah, right... that's good insight. Will definitely look into this one. Thanks marko.

Sign In

Nearest point form mtext to pline, but horizontaly

Recommended Posts

pietrow

Link to comment

Share on other sites

Emmanuel Delay

Link to comment

Share on other sites

Tharwat

Link to comment

Share on other sites

Jonathan Handojo

Link to comment

Share on other sites

marko_ribar

Link to comment

Share on other sites

Jonathan Handojo

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity