Attaching data to blocks created from a polyline

Hi All,

I have a routine which is made up from lots of bits on this forum which allows me to convert a polyline to a block with a unique ID (user entered), what I need to do now is attach data to each block as it is created, the data is the area, the entity ID (dot notation 5) and the unique ID. I can get all the information but I am at a loss how I attach the data in the lisp routine which uses vla-insertblock. The routine works by creating the block from polyline and inserting it at centre point of orignal polyline and then deletes the orignal polyline.

Any pointers would be really helpful and save what's left of my hair.

Thanks

Hi John,

Are you referring to populating block attributes?

Hi Lee,

Yes block attributes. I am not sure if I need to create a block with the three attributes which I then use to convert polyline to that block with a unique name or can I add the attributes after block is created but before lisp rotine ends

Hope this make sense.

John

What code to do you currently have? It may help me understand your problem better.

Hi Lee,

here is code, It go it from this forum, I have made a a few small changes

(defun c:MakeSpace (/ ss adoc pt_lst center blk *error* bi bname bpat sSpace)

;;;Make a space from selected entities

(setq bpat "SPACE-") ;_

(setq sSpace (getstring"\nPlease Enter Space ID."))

(if (tblsearch "BLOCK" sSpace) (exit))

(defun *error* (msg)

(vla-endundomark adoc) ;

(princ msg)

(princ)

) ;_ end of defun

(vl-load-com)

(vla-startundomark

(setq adoc (vla-get-activedocument (vlax-get-acad-object)))

) ;_ end of vla-StartUndoMark

(if (not (vl-catch-all-error-p

(vl-catch-all-apply '(lambda () (setq ss (ssget "_:L"))))

) ;_ end of vl-catch-all-error-p

) ;_ end of not

(progn

(setq

ss (mapcar 'vlax-ename->vla-object

(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))

) ;_ end of mapcar

pt_lst (apply 'append

(mapcar

'(lambda (x / minp maxp)

(vla-getboundingbox x 'minp 'maxp)

(list (vlax-safearray->list minp)

(vlax-safearray->list maxp)

) ;_ end of append

) ;_ end of lambda

ss

) ;_ end of mapcar

) ;_ end of append

center (mapcar '(lambda (a b) (/ (+ a b) 2.))

(list (apply 'min (mapcar 'car pt_lst))

(apply 'min (mapcar 'cadr pt_lst))

(apply 'min (mapcar 'caddr pt_lst))

) ;_ end of list

(list (apply 'max (mapcar 'car pt_lst))

(apply 'max (mapcar 'cadr pt_lst))

(apply 'max (mapcar 'caddr pt_lst))

) ;_ end of list

) ;_ end of mapcar

bname

(progn

(setq bi 0)

(setq bName sSpace)

(while (tblsearch "BLOCK" sSpace))

bname)

blk (vla-add (vla-get-blocks adoc)

(vlax-3d-point center)

bname

) ;_ end of vla-add

) ;_ end of setq

(vla-copyobjects

adoc

(vlax-make-variant

(vlax-safearray-fill

(vlax-make-safearray vlax-vbobject (cons 0 (1- (length ss))))

ss

) ;_ end of vlax-safearray-fill

) ;_ end of vlax-make-variant

blk

) ;_ end of vla-copyobjects

(vla-insertblock

(vla-objectidtoobject adoc (vla-get-ownerid (car ss)))

(vlax-3d-point center)

(vla-get-name blk)

1.0

1.0

1.0

0.0

) ;_ end of vla-insertblock

(mapcar 'vla-erase ss)

) ;_ end of and

) ;_ end of if

(vla-endundomark adoc)

(princ)

) ;_ end of defun

The bit I am strugling with is the vla-insertblock, I need to add the thre attributes after this has been done so I capture the auto cade entity id and add the sSpace id and area of ployline.

Hope this helps

John

Hi John,

Perhaps this will provide some ideas:

(defun c:MakeSpace ( / *error* BLOCK CEN DOC FLG ID NME OBJS SPC SS )
 (vl-load-com)
 ;; Lee Mac  ~  18.05.10

 (setq id "SPACE-")

 (defun *error* ( msg )
   (and flg (vla-EndUndoMark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (setq spc
   (if
     (or
       (eq AcModelSpace
         (vla-get-ActiveSpace
           (setq doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
           )
         )
       )
       (eq :vlax-true (vla-get-MSpace doc))
     )
     (vla-get-ModelSpace doc)
     (vla-get-PaperSpace doc)
   )
 )

 (initget 1)
 (setq nme (getstring "\nPlease Enter Space ID: "))

 (cond
   (
     (tblsearch "BLOCK" (strcat id nme))

     (princ "\n** Block Already Exists **")
   )
   (
     (not (setq ss (ssget "_:L")))
   )
   (
     (setq flg (not (vla-StartUndoMark doc)))

     (setq block
       (vla-Add (vla-get-Blocks doc)
         (vlax-3D-point
           (setq cen
             (apply (function mapcar)
               (cons
                 (function
                   (lambda ( x y )
                     (/ (+ x y) 2.)
                   )
                 )
                 (SSBoundingBox ss)
               )
             )
           )
         )
         (strcat id nme)
       )
     )

     (vla-copyObjects doc
       (ObjectVariant (setq objs (ss->vla ss))) block
     )

     (mapcar
       (function
         (lambda ( prmpt pt tag )
           (vla-AddAttribute block (getvar 'TEXTSIZE) 0 prmpt
             (vlax-3D-point pt) tag ""
           )
         )
       )
       (list "Tag 1: " "Tag 2: " "Tag 3: ")
       (list cen
         (polar cen (/ (* 3 pi) 2.) (* 1.5 (getvar 'TEXTSIZE)))
         (polar cen (/ (* 3 pi) 2.) (* 3.0 (getvar 'TEXTSIZE)))
       )
       (list "TAG1" "TAG2" "TAG3")
     )

     (if
       (vl-catch-all-error-p
         (vl-catch-all-apply (function vla-InsertBlock)
           (list spc (vlax-3D-point cen) (strcat id nme) 1. 1. 1. 0.)
         )
       )
       (princ "\n** Error Inserting Block **")
     )

     (mapcar (function vla-erase) objs)

     (setq flg (vla-EndUndoMark doc))
   )
 )
 (princ)
)


(defun ObjectVariant ( lst )
 (vlax-make-variant
   (vlax-safearray-fill
     (vlax-make-safearray vlax-vbObject
       (cons 0 (1- (length lst)))
     )
     lst
   )
 )
)

(defun SSBoundingBox ( ss / ent ll ur bBoxs )
 ;; Lee Mac  ~  18.03.10

 (  (lambda ( i )
      
      (while (setq ent (ssname ss (setq i (1+ i))))
        (vla-getBoundingBox (vlax-ename->vla-object ent) 'll 'ur)

        (setq bBoxs (cons (vlax-safearray->list ur)
                          (cons (vlax-safearray->list ll) bBoxs)))
      )
    )    
 -1
 )

 (mapcar
   (function
     (lambda (operation)
       (apply (function mapcar)
         (cons operation bBoxs)
       )
     )
   )
   '(min max)
 )
)

(defun ss->vla ( ss )
 (if ss
   (
     (lambda ( i / e l )
       (while (setq e (ssname ss (setq i (1+ i))))
         (setq l
           (cons
             (vlax-ename->vla-object e) l
           )
         )
       )
       l
     )
     -1
   )
 )
)

Also, be sure to read this.

Lee

Hi All,

I have come across something which seems very strange to me, but I am sure there is a very locigal explanantion for this.

I have used the code above which Lee kindly posted which works a treat. I now want to populate the data tags, one of which is I need to be the entity handle. If I try using

(setq hHandle (vla-get-handle block))

I get strange result, hHandle is "277", but if I use (entget (entlast)) the handle is 27A, this happens all the time the last charater is wrong. eg 233 for 23E or 244 for 24F

Am I doing something studip here, I had assumed that the handle was a text string not a hex number, I have put code to get handle after block is inserted as I had thought it may be something to do with picking up the original object handle before block was inserted.

I am at a bit of a loss here, not sure if it just a bit of string converstion, or do I need to revert to using the entget to gather the info.

Regards

John

If you are referring to the same entity, the handles will be identical, both hexadecimal strings.

Hi Lee,

It the same entity, it just the confussion as to why the vla-get-handle returns something different to entget? It happens on every entity I convert to a block.

Thanks

If its a in block, then its not the same entity - the code does not 'convert' the entity to a block, it merely makes a block from the entities - the hint is when you typed vla-copyobjects.

Hi Lee,

I understand your reply and this whta I has assumed, it may be the way I have put it across.

Having used the code I have converted a polyline to a block and added to TAG1 the entity handle using (setq nHandle (vla-get-handle block))) this puts on the drawing 50FC as the entity handle.

If I then issue following commands at command line

(setq en ( car (entsel))) [select the new block]

then

(entget en)

This returns all the data which includes (5 . "5103")

This is the problem I cannot resolve, as I want to check the nHandle value attached to block is correct one, which a t the moment it doesn't seem to be.

Hope this makes it a little clearer.

John

But are you retrieving the handle of the block defintion in the block table or the insert?

Hi Lee,

I had assumed I was getting the insert, or rather I had hoped I was getting the inserted block. Is there a method for getting at both, or is it dependant on where in the code I get the handle?

I will do some more investigating as I am sure I'm nearly there, but any pointers would be welocmed.

John

Here's a nudge in the right direction:

(defun c:MakeSpace ( / *error* BLOCK CEN DOC FLG ID NME OBJS SPC SS )
 (vl-load-com)
 ;; Lee Mac  ~  18.05.10

 (setq id "SPACE-")

 (defun *error* ( msg )
   (and flg (vla-EndUndoMark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (setq spc
   (if
     (or
       (eq AcModelSpace
         (vla-get-ActiveSpace
           (setq doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
           )
         )
       )
       (eq :vlax-true (vla-get-MSpace doc))
     )
     (vla-get-ModelSpace doc)
     (vla-get-PaperSpace doc)
   )
 )

 (initget 1)
 (setq nme (getstring "\nPlease Enter Space ID: "))

 (cond
   (
     (tblsearch "BLOCK" (strcat id nme))

     (princ "\n** Block Already Exists **")
   )
   (
     (not (setq ss (ssget "_:L")))
   )
   (
     (setq flg (not (vla-StartUndoMark doc)))

     (setq block
       (vla-Add (vla-get-Blocks doc)
         (vlax-3D-point
           (setq cen
             (apply (function mapcar)
               (cons
                 (function
                   (lambda ( x y )
                     (/ (+ x y) 2.)
                   )
                 )
                 (SSBoundingBox ss)
               )
             )
           )
         )
         (strcat id nme)
       )
     )

     (vla-copyObjects doc
       (ObjectVariant (setq objs (ss->vla ss))) block
     )

     (mapcar
       (function
         (lambda ( prmpt pt tag )
           (vla-AddAttribute block (getvar 'TEXTSIZE) 0 prmpt
             (vlax-3D-point pt) tag ""
           )
         )
       )
       (list "Tag 1: " "Tag 2: " "Tag 3: ")
       (list cen
         (polar cen (/ (* 3 pi) 2.) (* 1.5 (getvar 'TEXTSIZE)))
         (polar cen (/ (* 3 pi) 2.) (* 3.0 (getvar 'TEXTSIZE)))
       )
       (list "TAG1" "TAG2" "TAG3")
     )

     (if
       (vl-catch-all-error-p
         (setq bObj
           (vl-catch-all-apply (function vla-InsertBlock)
             (list spc (vlax-3D-point cen) (strcat id nme) 1. 1. 1. 0.)
           )
         )
       )
       (princ "\n** Error Inserting Block **")
       (foreach att (vlax-invoke bObj 'GetAttributes)
         (vla-put-TextString att (vla-get-Handle bObj))
       )
     )

     (mapcar (function vla-erase) objs)

     (setq flg (vla-EndUndoMark doc))
   )
 )
 (princ)
)


(defun ObjectVariant ( lst )
 (vlax-make-variant
   (vlax-safearray-fill
     (vlax-make-safearray vlax-vbObject
       (cons 0 (1- (length lst)))
     )
     lst
   )
 )
)

(defun SSBoundingBox ( ss / ent ll ur bBoxs )
 ;; Lee Mac  ~  18.03.10

 (  (lambda ( i )
      
      (while (setq ent (ssname ss (setq i (1+ i))))
        (vla-getBoundingBox (vlax-ename->vla-object ent) 'll 'ur)

        (setq bBoxs (cons (vlax-safearray->list ur)
                          (cons (vlax-safearray->list ll) bBoxs)))
      )
    )    
 -1
 )

 (mapcar
   (function
     (lambda (operation)
       (apply (function mapcar)
         (cons operation bBoxs)
       )
     )
   )
   '(min max)
 )
)

(defun ss->vla ( ss )
 (if ss
   (
     (lambda ( i / e l )
       (while (setq e (ssname ss (setq i (1+ i))))
         (setq l
           (cons
             (vlax-ename->vla-object e) l
           )
         )
       )
       l
     )
     -1
   )
 )
)

Hi Lee,

Many thanks fot you help. I am just now getting grip with visual Lisp. I can seen where to go with the code.

I will give it a go in the morning.

Regards

John

Excellent - let me know if you get stuck

Hi Lee,

I have tried the code you have suggested, and I get an error. If I change the bObj to varible block then I get the error ActiveX server returned the error unknown name "GETATTRIBUTES. I am sure block is correct as this is the block just inserted.

If I chage bObj to Obj (which I thinks is wrong as this is a set) then I get error saying bad argument type VLA-OBJECT nil

I am sure block is correct but not sure why Get the error, I think I may have just got the object wrong.

Sorry to be such a pest.

Can you recomend a good visual lisp reference book?

Many thanks

John

Why are you trying to change the variable 'bObj'? The variable 'block' points to the block definition within the block table, - not the inserted block reference (INSERT). 'Objs' is a list of VLA-Objects.

What are you trying to achieve?

As for the book, I would recommend the Visual LISP Help files - you can learn a great deal from them (plus they are free).

Hi Lee,

Sorry I hadn't put brian in gear, I miss-read the insert block lines an thought it was just Obj and not bObj.

Sorry about that.

I will read through the help files, thy seem to be a very good start point.

Many thanks

Hi Lee,

Many thanks for your help and support. I now have it working and it does everything I need. Your help and pointers had made a great difference.

Many thanks

John