Looking for an even better LISP routine that can place blocks on a measured point

[LukasA-HAK]

I use this very handy LISP routine: IBP

(defun c:ibp(/ nb sp s i sn pc lpc x)
(setq nb (getstring "\nEnter Block name: "))
(if (tblsearch "block" nb)
(progn
(setq sp (entget (car (entsel "\nSelect Base Point: ")))
s (ssget "a" (list '(0 . "point") (assoc 8 sp)))
)
(repeat (setq i (sslength s))
(setq sn (entget (ssname s (setq i (1- i))))
pc (cdr (assoc 10 sn))
lpc (cons pc lpc)
)
)
(foreach x lpc
(entmake (list '(0 . "insert")
(cons 2 nb)
(cons 10 x)
)
)
)
)
(princ "¡¡¡Block Name does Not Exist...!!! ")
)
(princ)
)
Lisp routine places blocks at points per layer:
- specify the block name.
-click on the wanted point.

The block is placed at every point per layer.

It is not ideal that attributes are polished away.

I'm looking for an even better LISP routine that can place blocks on a measured point.
See the autocad files in the attachment:
-GPS measurement file;
- As built drawing-end result;
It would be nice if the measurement file could be used as xref.
So first xref and then run the new command.

I hope I have worded it clearly

[Moshe-A]

@LukasA-HAK  hi,

check this IPB2 command 😀

it uses (InsertBlockWithAttributes) function from Gilles Chanteau.   W O N D E R F U L function. thank you very much Gilles.

The command starts by letting you to select the Block (or Xref) from the drawing (as oppose to typing the block name) so make sure the block/xref is inserted. if the block is an attribute block, it will be handled.

enjoy

Moshe

;;; InsertBlockWithAttributes (Gilles Chanteau)
;;; Creates a new block reference with attributes using entmake
;;;
;;; Arguments
;;; blockName : name of the block definition
;;; inspt     : insertion point
;;; layer     : insertion layer
;;; xScale    : X scale
;;; yScale    : Y scale
;;; rotation  : rotation (radians)
;;; attribs   : list of dotted pairs containing the attribute values (TAG . Value)
(defun InsertBlockWithAttributes (blockName insPt layer xScale yScale rotation attribs / mxv block ent attDefs insert tag elst)
 
  (defun mxv (m v)
    (mapcar (function (lambda (r) (apply '+ (mapcar '* r v))))
            m
    )
  )
  
  (if (setq block (tblsearch "block" blockName))
    (progn
      (setq ent   (cdr (assoc -2 block))
            xform (list (list (* xScale (cos rotation)) (* xScale (- (sin rotation))) 0.)
                        (list (* yScale (sin rotation)) (* yScale (cos rotation)) 0.)
                        (list 0. 0. 1.)
                  )
      )
      (while ent
        (if (= "ATTDEF" (cdr (assoc 0 (setq elst (entget ent)))))
          (setq attDefs (cons (cons (cdr (assoc 2 elst)) elst) attDefs))
        )
        (setq ent (entnext ent))
      )
      (setq insert (entmakex
                     (list
                       (cons 0 "INSERT")
                       (cons 8 layer)
                       (cons 66 1)
                       (cons 2 blockName)
                       (cons 10 insPt)
                       (cons 41 xScale)
                       (cons 42 yScale)
                       (cons 43 1.0)
                       (cons 50 rotation)
                     )
                   )
      )
 
      (foreach att (reverse attDefs)
        (setq tag  (car att)
              elst (cdr att)
        )
        (entmakex
          (list
            (cons 0 "ATTRIB")
            (cons 100 "AcDbEntity")
            (assoc 8 elst)
            (cons 100 "AcDbText")
            (cons 10 (mapcar '+ inspt (mxv xform (cdr (assoc 10 elst)))))
            (cons 40 (* yScale (cdr (assoc 40 elst))))
            (cons 1
                  (cond ((cdr (assoc tag attribs)))
                        (T (cdr (assoc 1 elst)))
                  )
            )
            (cons 50 rotation)
            (cons 41 (/ xScale yscale))
            (assoc 51 elst)
            (assoc 7 elst)
            (assoc 72 elst)
            (cons 11 (mapcar '+ inspt (mxv xform (cdr (assoc 11 elst)))))
            (cons 100 "AcDbAttribute")
            (assoc 280 elst)
            (cons 2 tag)
            (assoc 70 elst)
            (assoc 74 elst)
            (assoc 280 (reverse elst))
          )
        )
      )
      (entmakex '((0 . "SEQEND")))
      (entlast)
    )
  )
); InsertBlockWithAttributes


(defun c:ibp2 (/ ss0 ss1 pick0 elist0 elist1 blocks AcDbBlkTblRec)
 (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startUndoMark adoc) 
  
 (if (and
       (not (prompt "\nPick Block/Xref to insert: "))       
       (setq ss0 (ssget ":s:e+." '((0 . "insert"))))
       (setq elist0 (entget (ssname ss0 0)))
       (eq (cdr (assoc '0 elist0)) "INSERT")
       (setq ss1 (ssget "_All" (list '(0 . "point") (assoc '8 elist0))))
     )
  (progn
   (setq blocks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
   (setq AcDbBlkTblRec (vla-item blocks (cdr (assoc '2 elist0))))
   
   (foreach ename1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))
    (setq elist1 (entget ename1))
    (if (eq (vla-get-isXref AcDbBlkTblRec) :vlax-false)
     (InsertBlockWithAttributes (cdr (assoc '2 elist0)) (cdr (assoc '10 elist1)) (cdr (assoc '8 elist0)) 1.0 1.0 0.0 nil)
     (entmake (list '(0 . "insert") (assoc '2 elist0) (assoc '10 elist1)))
    )  
   ); foreach

   (vlax-release-object AcDbBlkTblRec)
   (vlax-release-object blocks)
  ); progn
 ); if

 (vla-endUndoMark adoc)
 (vlax-release-object adoc)
  
 (princ) 
); ipb2

@ 

[LukasA-HAK]

Hi Moshe,

I just tried the command.
But it doesn't seem to work.
The command does ask to select a block.
But then the routine stops.

[Moshe-A · Accepted solution]

@LukasA-HAK 

You may be right, attached is a fix.

be aware that the lisp select points (and insert blocks) only from the layer of the selected block.

Moshe

[LukasA-HAK]

Thank you very much it works great!

[LukasA-HAK]

Very nice LISP thank you!