Jump to content

Auto insert block at intersection


MichaelAllfire

Recommended Posts

Hi all,

 

I have done some searching and have come across this code from Lee Mac.

 

(defun c:ib ( / *error* a b bfn blk cmd i j sel spc )

   (defun *error* ( msg )
       (LM:endundo (LM:acdoc))
       (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )
   
   (while
       (progn
           (setvar 'errno 0)
           (initget "Name Browse Exit")
           (setq sel (entsel "\nSelect block to insert [Name/Browse] <Exit>: "))
           (cond
               (   (= 7 (getvar 'errno))
                   (princ "\nMissed, try again.")
               )
               (   (or (null sel) (= "Exit" sel))
                   nil
               )
               (   (= "Browse" sel)
                   (if (setq bfn (getfiled "Select Block" (getvar 'dwgprefix) "dwg" 16))
                       (if (null (tblsearch "block" (setq blk (cadr (fnsplitl bfn)))))
                           (progn
                               (setq cmd (getvar 'cmdecho))
                               (setvar 'cmdecho 0)
                               (command "_.-insert" bfn nil)
                               (setvar 'cmdecho cmd)
                               (null (tblsearch "block" blk))
                           )
                       )
                       (princ "\n*Cancel*")
                   )
               )
               (   (= "Name" sel)
                   (while
                       (not
                           (or (= "" (setq blk (getstring t "\nSpecify block name <Select>: ")))
                               (tblsearch "block" blk)
                           )
                       )
                       (princ "\nBlock not found.")
                   )
                   (= "" blk)
               )
               (   (= 'list (type sel))
                   (if (= "INSERT" (cdr (assoc 0 (entget (car sel)))))
                       (setq blk (LM:blockname (vlax-ename->vla-object (car sel))))
                       (princ "\nObject is not a block.")
                   )
               )
           )
       )
   )

   (if
       (and
           (= 'str (type blk))
           (tblsearch "block" blk)
           (setq sel (ssget))
       )
       (progn
           (setq spc
               (vlax-get-property (LM:acdoc)
                   (if (= 1 (getvar 'cvport))
                       'paperspace
                       'modelspace
                   )
               )
           )
           (LM:startundo (LM:acdoc))
           (repeat (setq i (sslength sel))
               (setq a (vlax-ename->vla-object (ssname sel (setq i (1- i)))))
               (if (vlax-method-applicable-p a 'intersectwith)
                   (repeat (setq j i)
                       (setq b (vlax-ename->vla-object (ssname sel (setq j (1- j)))))
                       (if (vlax-method-applicable-p b 'intersectwith)
                           (foreach p (LM:intersections a b acextendnone)
                               (vla-insertblock spc (vlax-3D-point p) blk 1.0 1.0 1.0 0.0)
                           )
                       )
                   )
               )
           )
           (LM:endundo (LM:acdoc))
       )
   )
   (princ)
)

;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; obj1,obj2 - VLA-Objects with the intersectwith method applicable
;; mode      - acextendoption enum of intersectwith method

(defun LM:intersections ( obj1 obj2 mode / l r )
   (setq l (vlax-invoke obj1 'intersectwith obj2 mode))
   (repeat (/ (length l) 3)
       (setq r (cons (list (car l) (cadr l) (caddr l)) r)
             l (cdddr l)
       )
   )
   (reverse r)
)

;; Block Name  -  Lee Mac
;; Returns the true (effective) name of a supplied block reference
                       
(defun LM:blockname ( obj )
   (if (vlax-property-available-p obj 'effectivename)
       (defun LM:blockname ( obj ) (vla-get-effectivename obj))
       (defun LM:blockname ( obj ) (vla-get-name obj))
   )
   (LM:blockname obj)
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
   (LM:endundo doc)
   (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
   (while (= 8 (logand 8 (getvar 'undoctl)))
       (vla-endundomark doc)
   )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
   (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
   (LM:acdoc)
)

(vl-load-com) (princ)

 

It does pretty much exactly what I need for my purposes, but I need to make an adjustment. When I start the command, it asks "Select block to insert" and gives me a choice of Name or Browse. I would like to be able to force a block choice instead of having the program ask for input.

 

eg. I run SBX in cad, and it forces the use of block "xhead" and then proceeds with the rest of the command.

 

If I could make the code type the letter N for Name and then type out xhead, that would also serve my purposes, but I don't know where to put that in.

 

Thanks in advance.

Link to comment
Share on other sites

Hi Lee,

 

That worked perfectly, thanks so much!

 

So, I now have the block in place (like so)

 

blocks in line.jpg

 

and I am wondering how to draw lines between the insertion points of those blocks. The insertion points are all aligned in a grid, with one edge of the grid longer than the other. However, the positions and quantities of these heads will differ in different situations. They will always be in a grid though. I am trying to draw lines connecting the blocks, in the direction of the longest length (like so)

 

blocks with lines.jpg

 

My thought would be to get the insertion points (that your previous code helped me get), and draw lines from point to point, but I don't know how I could differentiate between points on different lines, and ending up with lines from every block to every other block.

 

It's a pretty specific outcome I am after. Thoughts on where I should start on this?

Link to comment
Share on other sites

Since the code inserts blocks on intersection points isn't there already some sort of line grid in place?

Edited by Roy_043
Link to comment
Share on other sites

I would suggest using the sorting method I implemented in this example - i.e. grouping by equal y-coordinate and sorting the group by x-coordinate.

 

Lee, you have more than 30k posts in both forums, how the heck you can find/remember a code that you posted from 5 years ago?!

Link to comment
Share on other sites

Lee, you have more than 30k posts in both forums, how the heck you can find/remember a code that you posted from 5 years ago?!

 

Meticulous cataloguing of code examples & explanations to obviate wheel reinvention. ;) :P

Link to comment
Share on other sites

Thanks for the replies all!

 

Good point Roy, I might firstly try doing something with the existing lines, perhaps trimming or something between the first and last blocks. That seems to me to be a tad bit simpler than Lee's suggested link.

 

Lee, thank you again for your suggestion, you've helped me out a few times over the past few weeks and I appreciate it! The link you posted will keep me going for a while, because I have to actually learn what half of it means! I may have questions in the future!

 

You are all winners in my book! Thanks heaps!

Link to comment
Share on other sites

Hi Lee,

 

One more quick question. I need to make a selection set of all of the blocks that get inserted on intersections. I have used the basics of ssget, but only used with "every object on layer" so far.

 

Edit: I have worked that out on my own, but I can't work out how to get your Automatic Block Break command to work on the blocks that I have inserted. My initial thought was to create a selection set of the blocks, then run the command within my routine using (c:abbs) and choosing the selection set, but it seems that you can't give any arguments to a command run in this way. Is there a way in which I can run your abbs command using the selection set I have created?

Edited by MichaelAllfire
Link to comment
Share on other sites

I can't work out how to get your Automatic Block Break command to work on the blocks that I have inserted. My initial thought was to create a selection set of the blocks, then run the command within my routine using (c:abbs) and choosing the selection set, but it seems that you can't give any arguments to a command run in this way. Is there a way in which I can run your abbs command using the selection set I have created?

 

Yes - if you already have your selection set assigned to a variable (I have used the variable 'sel' in the example which follows), you can process it using my Automatic Block Break function in the following way:

(repeat (setq idx (sslength sel))
   (LM:AutoBlockBreak (ssname sel (setq idx (1- idx))) nil)
)

Link to comment
Share on other sites

Hi Lee, thanks for your help. I have noticed while testing my routine that when I undo after completing the command, it treats every block broken as a single action, meaning I have to use multiple uses of UNDO (often several dozen due to the number of blocks) to get back to the previous state of my drawing. However, when invoking ABBS normally within the drawing, when not a part of my code, it treats every break as a single action, and only requires one use of UNDO. Is there a way around this?

 

Could it have something to do with the rest of my code? I am almost too embarassed to post my code, as it is messy, long and VERY rudimentary. I'm sure I have broken every good practice while writing it :oops::unsure:

 

EDIT: Well then, seems I had a bit of code in the wrong place. I just added command _undo begin and command _undo end before and after your bit of code, and it worked. I had them elsewhere in the code. All good then! Thanks for all of your help!!

Link to comment
Share on other sites

I am almost too embarassed to post my code, as it is messy, long and VERY rudimentary. I'm sure I have broken every good practice while writing it :oops::unsure:

 

Don't worry - we all have to start somewhere!

It pains me to look over my early code & forum posts... :oops:

 

EDIT: Well then, seems I had a bit of code in the wrong place. I just added command _undo begin and command _undo end before and after your bit of code, and it worked. I had them elsewhere in the code. All good then! Thanks for all of your help!!

 

Glad you got it working! -

If I'd have posted earlier, I would have recommended you review lines 275-279 of my ABBS program for the answer. ;)

Link to comment
Share on other sites

  • 2 years later...

hello i want to ask if it possible to insert name on the line and put name in the block something like (line A, Line 1) and intersect point is (A1).

 

Thank you :)

Link to comment
Share on other sites

The answer to your question is yes, throw enough money at it and you will have a answer.

 

Its  a case of looking at the code in the way it inserts the blocks in a grid so a row column answer.

 

A double sort comes to mind on X Y. 

Link to comment
Share on other sites

  • 4 months later...

This is the lisp i looking for, i uppload the lisp i created if someone else need it .

 

;    _____________________________________________________
;   |*****************************************************|   
;   |   THIS LISP IS FOR LABELING CONSTRUCTION AXES       |   
;   |*****************************************************|   
;   |*THE CROSSING AXES IN GEODESY AND CONSTRUCTION       |   
;   |*ARE IMPORTANT IN MY CASE WITH THEIR INTERSECT POINT |   
;   |*THEREFORE THS LISP LABELING THE INTERSECT POINT     |   
;   |*WITH LETTERS AND NUMBERS 'A1' 'A2' 'B1' 'B2'.....   |   
;   |*****************************************************|   
;   | SORRY FOR MY ENGLISH :)                             |   
;   | LISP CREATED BY : GEORGI GEORGIEV - TRUDY           |   
;   |_____________________________________________________|


(defun c:int ()
;;;;;;;;;;;;;;;;;;;;
;SELECT AXIS WITH LETTERS AND GROUP THEM IN LIST
;СЕЛЕКТИРА ОСИТЕ С БУКВИ И ГИ ГРУПИРА В ЛИСТ
(setq all '())
(setq all2 '())
(setq coor '())
(setq intt nil)
(alert "\nSELECT AXES WITH 'A' 'B' 'C' ...
		\nWHEN YOU ARE READY PRES - ENTER -")
(setq pl1 (entsel "\nSELECT AXES WITH LETTERS: "))
		
(progn
	(while (/= pl1 nil)
		(setq coor '())
		(setq nam (entget (car pl1)))
		(setq cor (assoc 10 nam))
		(setq buk  (getstring "\nWHICH LETTER IS THE AXIS: "))
						(while (/= cor nil)
							(setq coor (cons cor coor))
							(setq nam (vl-remove cor nam))
							(setq cor (assoc 10 nam))
						);end while
		;(princ coor)
		(setq all (cons (cons (reverse coor) buk) all))
		(setq pl1 (entsel "\nSELECT AXES WITH LETTERS: "))
	);end while
	(setq all (reverse all))
);end progn
;;;;;;;;;;;;;;;;;;;;
;SELECT AXIS WITH THE NUMBERS AND GROUP THEM IN LIST
;СЕЛЕКТИРА ОСИТЕ С ЦИФРИ И ГИ ГРУПИРА В ЛИСТ
(alert "\nNOW SELECT AXIS WITH NUMBER
		\nWHEN YOU ARE READY PRES - ENTER -")

(setq pl2 (entsel "\nSELECT AXIS WITH NUMBER: "))
(progn
	(while (/= pl2 nil)
		(setq coor '())
		(setq namm (entget (car pl2)))
		(setq cor2 (assoc 10 namm))
		(setq cif  (getstring "\nWHICH NUMBER IS THE AXIS: "))
						(while (/= cor2 nil)
							(setq coor (cons cor2 coor))
							(setq namm (vl-remove cor2 namm))
							(setq cor2 (assoc 10 namm))
						);end while
		(setq all2 (cons (cons (reverse coor) cif) all2))
		(setq pl2 (entsel "\nSELECT AXIS WITH NUMBER: "))
	);end while
	(setq all2 (reverse all2))
);end progn
(princ)
;;;;;;;;;;;;;
;INTERSECT POINTS FROM FIRST LIST AND SECOND LIST
(repeat (length all)
(setq allcif all2)
(setq bukX1 (car (cdr (caaar all)))
	  bukY1 (cadr (cdr (caaar all)))
	  bukX2 (car (cdr (car (cdr (caar all)))))
	  bukY2 (cadr (cdr (car (cdr (caar all)))))
	  bukN (cdr (car all))
	  bukXY1 (list bukX1 bukY1)
	  bukXY2 (list bukX2 bukY2)
)

		(repeat (length all2)
			(setq cifX1 (car (cdr (caaar allcif)))
				cifY1 (cadr (cdr (caaar allcif)))
				cifX2 (car (cdr (car (cdr (caar allcif)))))
				cifY2 (cadr (cdr (car (cdr (caar allcif)))))
				cifN (cdr (car allcif))
				cifXY1 (list cifX1 cifY1)
				cifXY2 (list cifX2 cifY2)
			)
			(setq int (inters bukXY1 bukXY2 cifXY1 cifXY2 T))
			(setq allcif (cdr allcif))
			(setq intt (cons (cons int (strcat bukN cifN)) intt))
		)
	(setq all (cdr all))
)
(setq intt (reverse intt))
;try2 is the name of the block
;Use your block with only one attribute for this lisp
(repeat (length intt)
			(command "_INSERT" "try2" "_Scale" 1.0 "_Rotate" 0 "_none" (car (car intt))
				(cdr (car intt))
			)
(setq intt (cdr intt))
)

(princ)


)

 

Link to comment
Share on other sites

43 minutes ago, Trudy said:

This is the lisp i looking for, i uppload the lisp i created if someone else need it .

 


...

 

Glad to see you solved your problem! One nitpick, remember to localize all of your code variables like so:

(defun c:int (/	      all     all2    allcif  buk     bukn    bukx1   bukx2   bukxy1  bukxy2
	      buky1   buky2   cif     cifn    cifx1   cifx2   cifxy1  cifxy2  cify1   cify2
	      coor    cor     cor2    int     intt    nam     namm    pl1     pl2
	     )
;; Code
)

🍻

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...