Looking for lisp to Copy Multiple Text Value to Multiple Blocks

[loudy000]

Hi Lisp guru's,

 

im looking for help or lisp to copy text/ mtext value to attribute as shown below,  by selection set or something, the goal is not to pick each and pick again where should it go.

Thanks.

copy.dwg

[BIGAL]

This is just a find text one selection set and look for a block within a defined search area and update attribute, search here or a google its been answered numerous times.

[loudy000]

can’t find multiple selection mode though

[BIGAL]

If you use a window selection and do it twice using the two corner pick points, ssget all the text, ssget all the blocks.

(setq pt1 (getpoint "pick 1st corner"))

(setq pt2 (getpoint pt1 "pick other corner"))

(setq txtss (ssget "w" pt1 pt2 (list (cons 0 "Text"))))

(setq blkss (ssget "w" pt1 pt2 (list (cons 0 "Insert"))))

Edited November 29, 2018 by BIGAL

[loudy000]

Hi Bigal thanks for this but i dont have idea how to use it :( 

[Roy_043]

Here is a solution based on code I have created for another thread.

Note: You have to remove mtext formatting first. This can be done by exploding mtexts or by using StripMtext.

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
    )
  )
)

(defun KGA_Geom_ObjectMiddle (obj / ptBL ptTR)
  (vla-getboundingbox obj 'ptBL 'ptTR)
  (mapcar
    '/
    (mapcar '+ (vlax-safearray->list ptBL) (vlax-safearray->list ptTR))
    '(2.0 2.0 2.0)
  )
)

(defun c:Test ( / disVec doc blkLst pt tab txtLst)
  (setq disVec '(38.8751 25.4295)) ; Half of diagonal.
  (setq tab (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model"))
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if
    (and
      (setq blkLst
        (KGA_Conv_Pickset_To_ObjectList
          (ssget "_A" (list (cons 410 tab) '(0 . "INSERT") '(2 . "BOX")))
        )
      )
      (setq txtLst
        (KGA_Conv_Pickset_To_ObjectList
          (ssget "_A" (list (cons 410 tab) '(0 . "*TEXT") '(1 . "*BOX*")))
        )
      )
    )
    (progn
      ; Note: texts have an elevation.
      (setq txtLst
        (mapcar
          '(lambda (obj) (list (KGA_Geom_ObjectMiddle obj) obj))
           txtLst
        )
      )
      (foreach blk blkLst
        (setq pt (KGA_Geom_ObjectMiddle blk))
        (vl-some
          '(lambda (txtSub)
            (if (vl-every '> disVec (mapcar 'abs (mapcar '- pt (car txtSub))))
              (progn
                (vla-put-textstring (car (vlax-invoke blk 'getattributes)) (vla-get-textstring (cadr txtSub)))
                (vla-delete (cadr txtSub))
                (setq txtLst (vl-remove txtSub txtLst))
                T
              )
            )
          )
          txtLst
        )
      )
      (princ "\nDone! ")
    )
  )
  (vla-endundomark doc)
  (princ)
)

 

Edited December 2, 2018 by Roy_043

[loudy000]

thanks Roy, but unfortunately nothing happened when i test it. Cheers

[Roy_043]

Your new test dwg is quite different. Please test with your original copy.dwg. And then explain...

[loudy000]

ah right! so it's reading the block name?

and if it's different block i'll just match the block name...Thank you very much.

(ssget "_A" (list (cons 410 tab) '(0 . "INSERT") '(2 . "BOX")))

[Roy_043]

My code assumes a fixed "BOX" block and that the rotation angle of the references is 0. As per your first example.

[loudy000]

Thanks Roy