Leaderboard

Is the hatch on a no plot layer, post dwg so can look at it.

http://www.lee-mac.com/steal.html (Steal "C:\\My Folder\\MyDrawing.dwg" '(( "Layouts" ("Layout1" "Layout2")))

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

Look at function : (vlax-curve-getclosestpointtoprojection) and study it...

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) )

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)) ) ) )

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")) )