Label pline intersected point 1.0.0

The idea is interesting, but couple things I don't get:

 

1. I don't understand why you'd need a block for this LISP. Simply generating a text should be enough.
2. If you're using (command), watch your snaps. It can mess up. You're better off setting snaps to off using (setvar 'osmode 0)

 

Since this one is an interesting topic, here's one that I created that will work on all curves as shown in the image below (self-intersecting are not catched):

 

 

(defun c:gl (/ del dets dt hgt inpt ints ln tx)
    (setq hgt 100	; <--- Height of text
	  del "-"	; <--- Delimiter to join the two grid texts
	  )
    (while
	(progn
	    (setvar 'errno 0)
	    (setq ln (progn (initget "End") (entsel "\nSelect grid line <end>: ")))
	    (cond
		((eq (getvar 'errno) 7) (princ "\nNothing selected"))
		((null ln) nil)
		((null
		     (vl-position
			 (cdr (assoc 0 (entget (setq ln (car ln)))))
			 '("LINE" "LWPOLYLINE" "ARC" "SPLINE" "ELLIPSE")
			 )
		     )
		 (princ "\nObject is not a curve")
		 )
		((or
		     (equal (vlax-curve-getStartPoint (setq ln (vlax-ename->vla-object ln))) (vlax-curve-getEndPoint ln) 1e-7)
		     (and
			 (vlax-property-available-p ln 'Closed)
			 (eq (vla-get-Closed ln) :vlax-true)
			 )
		     )
		 (princ "\nObject is a closed curve")
		 )
		((member ln (mapcar 'cdr dets)) (princ "\nCurve is already previously selected"))
		(t
		 (while
		     (progn
			 (setvar 'errno 0)
			 (setq tx (progn (initget "Text") (entsel "\nSelect text representing grid line or [Text] <exit>: ")))
			 (cond
			     ((eq (getvar 'errno) 7) (princ "\nNothing selected"))
			     ((null tx) nil)
			     ((eq tx "Text")
			      (while
				  (progn
				      (setq tx (strcase (getstring t "\nSpecify text for polyline: ")))
				      (cond
					  ((eq tx "") (princ "\nEmpty text not allowed"))
					  ((assoc tx dets) (princ (strcat "\nLabel \"" tx "\" is already used.")))
					  )
				      )
				  )
			      )
			     ((not (vl-position (cdr (assoc 0 (entget (car tx)))) '("TEXT" "MTEXT"))) (princ "\nObject is not text"))
			     ((assoc (setq tx (cdr (assoc 1 (entget (car tx))))) dets) (princ (strcat "\nLabel \"" tx "\" is already used.")))
			     ((not tx))
			     )
			 )
		     )
		 
		 (if
		     (eq (getvar 'errno) 0)
		     (setq dets (cons (cons tx ln) dets))
		     )
		 )
		)
	    )
	)

    (foreach dt (setq dets (reverse dets))
	(mapcar
	    '(lambda (x / inpt ints)
		 (if (setq ints (vlax-invoke (cdr dt) 'IntersectWith (cdr x) acExtendNone))
		     (while (vl-remove nil (setq inpt (list (car ints) (cadr ints) (caddr ints))))
			 (entmake
			     (list
				 '(0 . "TEXT")
				 '(100 . "AcDbEntity")
				 '(100 . "AcDbText")
				 (cons 10 inpt)
				 (cons 40 hgt)
				 (cons 1 (strcat (car dt) del (car x)))
				 (cons 7 (getvar 'textstyle))
				 )
			     )
			 (setq ints (cdddr ints))
			 )
		     )
		 )
	    (setq dets (cdr dets))
	    )
	)
    (princ)
    )

(vl-load-com)

 

 

In work we work with architects and constructors and on arh axis sometimes i have (1,2,3,....20) and (A B C .... Z) its depend from project and i have to get all of inters point in table with coord and i found one lisp for create table with block name and X Y, this is the reason for block.

In latest version in intersect points i use cogo and create dynamic table in civil.

 

I'm assuming what you found was from Lee Mac's website. I think it's much more efficient and faster if you can gather the intersection point and create a table yourself all in one command rather than relying on blocks. Plus, (command) tends to work about 6 times much slower as opposed to vla-InsertBlock. What's worse with (command), if your snaps aren't off, your blocks could insert in the wrong point due to snap (for example, if only your endpoint or midpoint snap is on and the rest are off), and your table will report incorrect values.

 

So considering A B C - Z and 1 2 3 - 20, that's about 500 intersections. It will take too long to use (command) to insert that many blocks and then changing its attributes.

 

i will modify it without (command) thank you for let me know