Column Grid Intersections with Blocks

[Magnum Z]

So I've been at this Lisp Routine for a little while now.  Done a lot of searching and researching.  I'm almost at the finish line and I need some help with the last few steps.  Or at least, the next to last step.

 

So the ultimate goal here is to use our column grid to generate an indicator at intersections.  Grid is created more or less by hand so it will always vary.  I decided to use the method of placing blocks with attributes at selected column lines' intersections.

 

I've taken care of selection issues of DTEXT vs MTEXT and assigning LINE objects with said TEXT objects.  I've whittled down what I would call the big issues except for one.

 

My final result has been a list of "pairs" like this example: (((-2376.0 -504.001 0.0) L) ((-2376.0 -504.001 0.0)  ((-2016.0 -504.001 0.0) L) ((-2016.0 -504.001 0.0) 7.1)...)

 

The first part of each item is a point list followed by the corresponding text/string to be used for the block attributes.  Problem is I need to combine the items with the same point so that each item will be as follows (((-2376.0 -504.001 0.0) 8 L) ((-2016.0 -504.001 0.0) 7.1 L)...).  Now I believe I can workout the order in which they are listed to suit my purposes, but I'm having trouble just combining the two strings with the same point.

 

After this hurdle, I'll need to insert the block WITH those strings filling in the attributes, but I believe I can figure that part out.

 

I've attached a drawing with a sample grid and the lisp routine I've pieced together so far.

 

Here's the main portion of the code in case that's all someone needs:

(defun c:setupint (/ mspc ss_txt ss_lines pntlst grdlst	attlst i_pnt i_grd ob_pnt ob_grd pnt1 pnt2
		   pnt3	ob_strg	blk)
  (setq mspc (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
  (if (and (princ "\nSelect Grid Text: ")
	   (setq ss_txt (ssget '((0 . "TEXT,MTEXT"))))
	   (princ "\nSelect Grid Lines: ")
	   (setq ss_lines (ssget '((0 . "LINE"))))
	   (setq pntlst (SF:sortyx (LM:intersectionsinset ss_lines)))
	   (setq grdlst (MT:GrdAcList ss_lines ss_txt))
      )
    (repeat (setq i_pnt (length pntlst))
      (setq ob_pnt (nth (setq i_pnt (1- i_pnt)) pntlst))
      (repeat (setq i_grd (length grdlst))
	(setq ob_grd  (nth (setq i_grd (1- i_grd)) grdlst)
	      pnt1    ob_pnt
	      pnt2    (vlax-curve-getStartPoint (cadr ob_grd))
	      pnt3    (vlax-curve-getEndPoint (cadr ob_grd))
	      ob_strg (car ob_grd)
	)
	(if (LM:Collinear-p pnt1 pnt2 pnt3)
	  (setq attlst (cons (list ob_pnt ob_strg) attlst))	      ;list of text with corresponding point
	)
      )								      ;end repeat grd
    )								      ;end repeat pnt
  )
  (setq blk "setupint")
  (princ attlst)						      ;Test Print of list
;;;  (foreach itm attlst
;;;    (setq p (list (nth 0 (car itm)) (nth 1 (car itm)) (nth 2 (car itm))))
;;;    (princ p)
;;;    (vla-insertblock mspc (vlax-3D-point p) blk 1.0 1.0 1.0 0)
;;;  )
)
(vl-load-com)
(princ)

 

SETUP TEST.dwg setupintV2.lsp

[Magnum Z]

Wouldn't you know it.  I figured it out after posting this and it took a few extra "minutes" to figure out the block insertion with attributes soooo...

 

Here's the 'working' code:

(defun c:setupint (/	    mspc     ss_txt   ss_lines pntlst	grdlst	 attlst	  i_pnt	   i_grd
		   ob_pnt   ob_grd   pnt1     pnt2     pnt3	ob_strg	 blk	  idx1	   idx2
		   obj1	    obj2     attlstfinal       atts
		  )
  (setq mspc (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
  (if (and (princ "\nSelect Grid Text: ")			      ;start and ;grid text prompt
	   (setq ss_txt (ssget '((0 . "TEXT,MTEXT"))))		      ;filter text objects of grid
	   (princ "\nSelect Grid Lines: ")			      ;grid lines prompt
	   (setq ss_lines (ssget '((0 . "LINE"))))		      ;filter line objects of grid
	   (setq pntlst (SF:sortyx (LM:intersectionsinset ss_lines))) ;list of intersection points of grid lines
	   (setq grdlst (MT:GrdAcList ss_lines ss_txt))		      ;list of grid lines with associated text
      )								      ;end and
    (repeat (setq i_pnt (length pntlst))			      ;start repeat point
      (setq ob_pnt (nth (setq i_pnt (1- i_pnt)) pntlst))	      ;set variable for intersection point
      (repeat (setq i_grd (length grdlst))			      ;start repeat grid
	(setq ob_grd  (nth (setq i_grd (1- i_grd)) grdlst)	      ;set variable for line object with string
	      pnt1    ob_pnt					      ;intersection point
	      pnt2    (vlax-curve-getStartPoint (cadr ob_grd))	      ;1st point on line object
	      pnt3    (vlax-curve-getEndPoint (cadr ob_grd))	      ;2nd point on line object
	      ob_strg (car ob_grd)				      ;line object's associated string/text
	)
	(if (LM:Collinear-p pnt1 pnt2 pnt3)			      ;collinear check - line vs intersection point
	  (setq attlst (cons (list ob_pnt ob_strg) attlst))	      ;list of text with corresponding point
	)
      )								      ;end repeat grid
    )								      ;end repeat point
  )
  (repeat (setq idx1 (length attlst))
    (setq obj1 (nth (setq idx1 (1- idx1)) attlst))
    (repeat (setq idx2 idx1)
      (setq obj2 (nth (setq idx2 (1- idx2)) attlst))
      (if (= (nth 0 (car obj1)) (nth 0 (car obj2)))
	(setq attlstfinal (cons (list (nth 0 obj1) (nth 1 obj1) (nth 1 obj2)) attlstfinal))
      )
    )
  )
  (foreach itm attlstfinal
    (setq p (list (nth 0 (car itm)) (nth 1 (car itm)) (nth 2 (car itm))))
    (setq blk (vla-insertblock mspc (vlax-3D-point p) "setupint" 1.0 1.0 1.0 0))
    (foreach atts (vlax-invoke blk 'GetAttributes)
      (if (= (vla-get-Tagstring atts) "GRID_INT_VERT")
	(vla-put-textstring atts (nth 1 itm))
      )
      (if (= (vla-get-Tagstring atts) "GRID_INT_HORZ")
	(vla-put-textstring atts (nth 2 itm))
      )
    )
  )
  (vl-load-com)
  (princ)
)
;; Grid Association List - Generates Listed Pairs of Grid Line with intersecting Grid Text
(defun MT:GrdAcList (ssl sst / i_txt i_line ob_txt ob_line rtn strg)
  (repeat (setq i_line (sslength ssl))
    (setq ob_line (vlax-ename->vla-object (ssname ssl (setq i_line (1- i_line)))))
    (repeat (setq i_txt (sslength sst))
      (setq ob_txt (vlax-ename->vla-object (ssname sst (setq i_txt (1- i_txt))))
	    strg   (vla-get-TextString ob_txt)
      )
      (if (/= nil (LM:intersections ob_line ob_txt acextendthisentity))
	(setq rtn (cons (list (vl-princ-to-string (read strg)) ob_line) rtn))
      )
    )
  )
)
;; Intersections in Set  -  Lee Mac
;; Returns a list of all points of intersection between all objects in a supplied selection set.
;; sel - [sel] Selection Set
(defun LM:intersectionsinset (sel / id1 id2 ob1 ob2 rtn)
  (repeat (setq id1 (sslength sel))
    (setq ob1 (vlax-ename->vla-object (ssname sel (setq id1 (1- id1)))))
    (repeat (setq id2 id1)
      (setq ob2	(vlax-ename->vla-object (ssname sel (setq id2 (1- id2))))
	    rtn	(cons (LM:intersections ob1 ob2 acextendnone) rtn)
      )
    )
  )
  (apply 'append (reverse rtn))
)
;; Intersections  -  Lee Mac
;; 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
(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)
)
;; Collinear-p  -  Lee Mac
;; Returns T if p1,p2,p3 are collinear
(defun LM:Collinear-p (p1 p2 p3)
  ((lambda (a b c)
     (or (equal (+ a b) c 0.001)
	 (equal (+ b c) a 0.001)
	 (equal (+ c a) b 0.001)
     )
   )
    (distance p1 p2)
    (distance p2 p3)
    (distance p1 p3)
  )
)
;;Sorts Intersection Point List by Y then X
(defun SF:sortYX (ptlist / yvals newptlist)
  (foreach pt ptlist
    (if	(not (vl-remove-if-not '(lambda (y) (equal (cadr pt) y 0.0001)) yvals))
      (setq yvals (cons (cadr pt) yvals))
    )								      ; end if
  )								      ; end foreach
  (setq yvals (vl-sort yvals '(lambda (y1 y2) (< y1 y2))))	      ; sort from least to greatest
  (foreach yval	yvals
    (setq pts	    (vl-remove-if-not '(lambda (pt) (equal yval (cadr pt) 0.0001)) ptlist)
	  pts	    (vl-sort pts '(lambda (pt1 pt2) (< (car pt1) (car pt2))))
	  newptlist (append newptlist pts)
    )								      ; end setq
  )								      ; end foreach
  newptlist
)								      ; end defun

Lots of subfunctions (thanks Lee Mac and other sources) but it works.  I'm sure this could be cleaned up and/or simplified a good bit.  I'd like to still see suggestions if anyone has any.  After I finalize a few more bells and whistles, I'll fully comment this thing and post my completed lisp in case anyone else can use it or even learn from it, maybe.

[Jonathan Handojo]

Buddy, you could be missing some of the great fun that people been posting. You can thank @Trudy for this: 

 

[Magnum Z]

On 12/13/2020 at 12:06 AM, Jonathan Handojo said:

Buddy, you could be missing some of the great fun that people been posting. You can thank @Trudy for this: 

 

Correct me if I'm wrong but that looks like a program I ran into when first doing some searches and it appears to only do one gridline at a time.

 

Mine will take two selection sets, no matter if it's one pair or many, and do them all at once.  However it won't do plines...yet.

 

Thanks anyway though.

Edited December 14, 2020 by Magnum Z