Copy+rotate from block position to block position

[kasperwuyts]

Hi all.

First of all: I have no experience whatsoever using Autolisp.

I have a question concerning a potential lisp routine that could greatly speed up my work. I have to resort to lisp because VBA/other options are unavailable to my in my current job.

I very often need to position certain blocks relative to eachother in identical ways.

Imagine having drawn 15 bolts, all rotated differently, and having to add washers to them. All the washers are positioned relative to the bolt blocks in the same way.

Right now my options are the Mocoro command and the Align command. I'm just doing this so many times a day (100+ times) that I think a faster command is worth it.

(the specifics of why I can't just add the washers to the block itself dynamically would lead me too far)

Tekla Structures has this incredibly useful function called 'copy from object to object'. i'm looking to recreate that here. 

So basically I want to do this:

 Can anyone help me out? I can do the arithmetic of transforming the block coordinates and rotation myself but the code to select/manipulate block properties is beyond me.

If anyone can help me on the way with sample code to select blocks, get properties from a block, and copy blocks, I think I can already figure out the rest.

Extra bonus points:

-if there is a possibility of skipping the first select if I already have something selected upon activating the command

-if I can continue selecting destination blocks without ending the command

Thank you very much to anyone  who can point me in the right direction.

Kasper

[ВeekeeCZ]

Start with posting a dwg sample to test.

[kasperwuyts]

Here is a sample DWG as requested.

[ВeekeeCZ · Accepted solution]

Try this... just slightly tested. It matches rotation and scale. (it fails if Xscale /= Yscale)

(vl-load-com)

(defun c:CopyBref (/ *error* :HighlightObjects :getblockanonymname s p n r d)  ;ctrl+shift B
  
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (if n (command-s "_.PURGE" "_B" n "_no"))
    (if s (:HighlightObjects s :vlax-false))
    (setvar 'cmdecho 1)
    (princ))
  
  (defun :getblockanonymname ( / d r n)
    (while (setq d (tblnext "BLOCK" (null d)))
      (if (wcmatch (setq n (cdr (assoc 2 d))) "C$*")
	(setq r (cons n r))))
    (cond ((car (vl-sort r '>)))
	  ("C$1000")))

    (defun :HighlightObjects (s h / i)
    (repeat (setq i (sslength s))
      (vlax-invoke-method (vlax-ename->vla-object (ssname s (setq i (1- i)))) 'Highlight h))
    T)
  
  (if (and (setq s (ssget "_:L"))
	   (setq r (entsel "\nSource block reference: "))
	   (setq r (entget (car r)))
	   (setq n (:getblockanonymname))
	   (setq n (strcat "C$" (itoa (1+ (atoi (substr n 3))))))
	   (setvar 'cmdecho 0)
	   (vl-cmdf "_.-BLOCK" n "_non" (trans (cdr (assoc 10 r)) 0 1)  s "" "_.OOPS")
	   (:HighlightObjects s :vlax-true)
	   )
    (while (setq d (entsel "\nDestination block reference: "))
      (and (setq d (entget (car d)))
	   (vl-cmdf "_.-INSERT" n 
		    "_s" (/ (cdr (assoc 41 d)) (cdr (assoc 41 r)))
		    "_r" (angtos (- (cdr (assoc 50 d)) (cdr (assoc 50 r))) (getvar 'aunits) 10)
		    "_non" (trans (cdr (assoc 10 d)) 0 1)
		    "_.EXPLODE" "_L")
	   )))
  (*error* "end")
  )

[kasperwuyts]

Works perfectly. Amazing. You provided a completely finalized solution in an almost shorter time than it took me to describe the problem.

Thank you very, very much for your time and effort.

[calderg1000]

Regards @kasperwuyts 

Try this code.
It allows you to insert a previously created block with the entities you require.
I show you the workflow in the video screencast. The workflow, I think it can also be useful for other similar cases.

https://knowledge.autodesk.com/es/support/civil-3d/learn-explore/caas/screencast/Main/Details/65753e...

(defun c:ib (/ s i sn p a b)
  (setq s (ssget '((0 . "insert")))
        b (getstring "Enter Block Name To Insert:")
  )
  (repeat (setq i (sslength s))
    (setq sn (vlax-ename->vla-object (ssname s (setq i (1- i))))
          p  (vlax-get sn 'insertionPoint)
          a  (vlax-get sn 'Rotation)
    )
    (entmake (list (cons 0 "Insert")
                   (cons 2 b)
                   (cons 10 p)
                   (cons 50 a)
             )
    )
  )
)