Jump to content

Blocks and polylines


ZZombie

Recommended Posts

I'm not too sure how to go about this, but I think it'll involve using dynamic blocks...

 

I would like to have a block with 4 attributes: 1) Name 2)# of instances 3) Width 4) Height.

 

Name and number is determined at the time block is inserted.

 

I would like the block to be able to pull the width/height from a polyline (square) it is assigned to in the drawing. So if the polyline width/height ever change, it will automatically update the blocks attributes for width and height.

 

I already have the block and its attributes setup, i just need to figure out the above.

 

Also, would there be a way for #2 to change the actual count on that name of block? So if i insert it once, and put 3 in # of instances, it'll tell me there are 3 of that block.

 

Anyone have some ideas?

Link to comment
Share on other sites

I use acad2007....

Start with Fields which can be inserted in Attributes... But I think you might need a Lisp or something to get it to prompt you upon insertion.

Link to comment
Share on other sites

Yea, that was my first solution actually. Already made it to prompt width/height upon insertion. Realized the sizes can change and it wouldnt update the block, which I end up extracting to use in excel.

 

Would be cool to see a block of any kind that can update its attributes based off a polyline, could be something to go off of...

Link to comment
Share on other sites

once you change the things, make sure you Update Fields and then select everything... not instant, but a small step anyway.

Link to comment
Share on other sites

This should get you by, but for automatic updating, you would need to add to the object's xdata and use a reactor - which takes more coding.

 

(defun c:blkUpd (/ ins Wid Hgt bEnt bObj
                  pEnt pObj MiP MaP win num)
 (vl-load-com)

[b][color=Red]  (setq ins "INSTANCES")   ;; << Instances Tag
 (setq Wid "WIDTH")       ;; << Width Tag
 (setq Hgt "HEIGHT")      ;; << Height Tag[/color][/b]
 
 (if
   (and
     (setq bEnt
       (car (entsel "\nSelect Block: ")))
     (eq "AcDbBlockReference"
         (vla-get-ObjectName
           (setq bObj
             (vlax-ename->vla-object bEnt))))
     (eq (vla-get-HasAttributes bObj) :vlax-true)
     (setq pEnt
       (car (entsel "\nSelect Polyline: ")))
     (wcmatch
       (cdr (assoc 0 (entget pEnt))) "*POLYLINE"))
   (progn
     (vla-getBoundingBox
       (setq pObj
         (vlax-ename->vla-object pEnt)) 'MiP 'MaP)
     (setq win (mapcar 'vlax-safearray->list (list MiP MaP))
           num (sslength
                 (ssget "_X"
                   (list
                     (cons 0 "INSERT")
                       (cons 2 (vla-get-Name bObj))
                         (cons 66 1)))))            
     (foreach Att (vlax-safearray->list
                    (vlax-variant-value
                      (vla-getAttributes bObj)))
       (cond
         ((eq ins (vla-get-TagString Att))
          (vla-put-TextString Att
            (rtos num 2 0)))
         ((eq Wid (vla-get-TagString Att))
          (vla-put-TextString Att
            (rtos
              (- (caadr win) (caar win)) 2 2)))
         ((eq Hgt (vla-get-TagString Att))
          (vla-put-TextString Att
            (rtos
              (- (cadadr win) (cadar win)) 2 2))))))
   (princ "\n<< Incorrect Selection >>"))
 (princ))

Make sure that the highlighted parts are the correct tag names for the attributes :)

 

Lee

Link to comment
Share on other sites

ZZombie,

 

If you could provide me with details of the Exact Block Name and Tag Names of its attributes, I could see about trying to create a LISP that uses reactors to update your block for you :)

Link to comment
Share on other sites

Oh wow, great job there Lee.

 

The att names im using are "NAME", "X-WIDTH", and "Y-HEIGHT"

 

The block name itself could vary in the drawing, I'd be placing multiple blocks for seperate panels actually, so this could create a bit of a problem :P Unless there is some way of extracting the information through the "Name" attribute.

 

Actually I've just attached a picture to show the info I'd need extracted.

 

Count.jpg

 

Again great job on what you came up with!

Link to comment
Share on other sites

Ok this should hopefully work.

 

A Few notes:

 

  • The code uses a reactor that reacts to grip-modifications, but won't work on normal command calls. I tried Object reactors, but had no luck.
  • The Tags are highlighted, alter these if necessary.
  • Type blkupd to invoke the command, click on the block and polyline to link them.
  • Type blkupdshow and hover over various Polylines to show links between blocks and polylines.

Any queries, just ask:

 

;; Block Attribute Updater  by Lee McDonnell 06.07.2009

(defun c:blkUpd (/ ins wid hgt bEnt bObj
                  pEnt pObj MiP MaP win num )
 (vl-load-com)

 (setq ins "COUNT")         ;; << Instances Tag
 (setq Wid "X-WIDTH")       ;; << Width Tag
 (setq Hgt "Y-HEIGHT")      ;; << Height Tag

 (if
   (and
     (setq bEnt
       (car (entsel "\nSelect Block: ")))
     (eq "AcDbBlockReference"
         (vla-get-ObjectName
           (setq bObj
             (vlax-ename->vla-object bEnt))))
     (eq (vla-get-HasAttributes bObj) :vlax-true)
     (setq pEnt
       (car (entsel "\nSelect Polyline: ")))
     (wcmatch
       (cdr (assoc 0 (entget pEnt))) "*POLYLINE"))
   (progn
     (vla-getBoundingBox
       (setq pObj
         (vlax-ename->vla-object pEnt)) 'MiP 'MaP)
     (mapcar
       (function
         (lambda (Obj)
           (putxdat Obj "LMACUPD"
             (vl-prin1-to-string
               (list
                 (vla-get-Handle pObj)
                   (vla-get-Handle bObj)))))) (list pObj bObj))
     (setq win (mapcar 'vlax-safearray->list (list MiP MaP))
           num (sslength
                 (ssget "_X"
                   (list
                     (cons 0 "INSERT")
                       (cons 2 (vla-get-Name bObj))
                         (cons 66 1)))))            
     (foreach Att (vlax-safearray->list
                    (vlax-variant-value
                      (vla-getAttributes bObj)))
       (cond
         ((eq ins (vla-get-TagString Att))
          (vla-put-TextString Att
            (rtos num 2 0)))
         ((eq Wid (vla-get-TagString Att))
          (vla-put-TextString Att
            (rtos
              (- (caadr win) (caar win)) 2 2)))
         ((eq Hgt (vla-get-TagString Att))
          (vla-put-TextString Att
            (rtos
              (- (cadadr win) (cadar win)) 2 2))))))
   (princ "\n<< Incorrect Selection >>"))
 (princ))

(defun c:BlkUpdshow (/ gr ent xtyp xval Objlst)
 (while
   (and
     (setq gr (grread t 13 2))
     (eq 5 (car gr)))
   (if (setq ent (car (nentselp (cadr gr))))
     (progn
       (vla-getXdata
         (vlax-ename->vla-object ent) "LMACUPD" 'xtyp 'xval)
       (if (and xtyp xval)
         (mapcar
           (function
             (lambda (x)
               (redraw x 3)))
           (setq Objlst
             (mapcar 'handent
               (read
                 (vlax-variant-value
                   (cadr
                     (vlax-safearray->list xval)))))))))
         (if Objlst
           (mapcar
             (function
               (lambda (x)
                 (redraw x 4))) Objlst))))
 (princ))
           

(defun BlkUpdr (Reac Args / ins wid hgt blk ss xtyp xval hand
                           pObj MiP MaP bObj win num)

 (setq ins "COUNT")         ;; << Instances Tag
 (setq Wid "X-WIDTH")       ;; << Width Tag
 (setq Hgt "Y-HEIGHT")      ;; << Height Tag
 
 (if (vl-position
       (car Args)
         '("GRIP_STRETCH"
           "GRIP_MOVE"
           "GRIP_SCALE"
           "GRIP_ROTATE"))
   (if (setq ss (cadr (ssgetfirst)))
     (progn
       (vla-getXdata
         (vlax-ename->vla-object
           (ssname ss 0)) "LMACUPD" 'xtyp 'xval)
       (if (and xtyp xval)
         (progn
           (setq hand
             (mapcar 'handent
               (read
                 (vlax-variant-value
                   (cadr
                     (vlax-safearray->list xval))))))
           (vla-getBoundingBox
             (setq pObj
               (vlax-ename->vla-object (car hand))) 'MiP 'MaP)
           (setq bObj (vlax-ename->vla-object (cadr hand))
                 win (mapcar 'vlax-safearray->list (list MiP MaP))
                 num (sslength
                       (ssget "_X"
                         (list
                           (cons 0 "INSERT")
                             (cons 2 (vla-get-Name bObj))
                               (cons 66 1)))))
           (foreach Att (vlax-safearray->list
                          (vlax-variant-value
                            (vla-getAttributes bObj)))
             (cond
               ((eq ins (vla-get-TagString Att))
                (vla-put-TextString Att
                  (rtos num 2 0)))
               ((eq Wid (vla-get-TagString Att))
                (vla-put-TextString Att
                  (rtos
                    (- (caadr win) (caar win)) 2 2)))
               ((eq Hgt (vla-get-TagString Att))
                (vla-put-TextString Att
                  (rtos
                    (- (cadadr win) (cadar win)) 2 2)))))))))))          

(defun putxdat (Obj App Data / ent type1 valeur)

 (setq xtype
   (vlax-make-variant
     (vlax-safearray-fill
       (vlax-make-safearray
         vlax-vbInteger '(0 . 1)) '(1001 1000))))

 (setq xval
   (vlax-make-variant
     (vlax-safearray-fill
       (vlax-make-safearray
         vlax-vbVariant '(0 . 1)) (list App Data))))

 (vla-setXData Obj xtype xval))

(if *lmac-Block*
 (vlr-remove *lmac-Block*)
 (setq *lmac-Block* nil))
(setq *lmac-Block*
 (vlr-command-Reactor nil
   (list
     (cons :vlr-CommandEnded 'BlkUpdr))))

Link to comment
Share on other sites

It works half the time for me. Some blocks i apply it to, it'll update both of the attributes, and the grip movements update fine. Although other times it wont even give a measurement to one of the attributes.

 

When I load it up though, i received this in the command window.

"Command: ; error: no function definition: VLR-COMMAND-REACTOR"

 

Seems that might be a problem? Although interesting how it works half the time :P

Link to comment
Share on other sites

Many thanks for the feedback :)

 

Hopefully this is more reliable:

 

;; Block Attribute Updater  by Lee McDonnell 06.07.2009

(defun c:blkUpd (/ ins wid hgt bEnt bObj
                  pEnt pObj MiP MaP win num )
 (vl-load-com)

 ;;<<  Tag Names must be Capitalised! >>
 (setq ins "COUNT")         ;; << Instances Tag
 (setq Wid "X-WIDTH")       ;; << Width Tag
 (setq Hgt "Y-HEIGHT")      ;; << Height Tag

 (if
   (and
     (setq bEnt
       (car (entsel "\nSelect Block: ")))
     (eq "AcDbBlockReference"
         (vla-get-ObjectName
           (setq bObj
             (vlax-ename->vla-object bEnt))))
     (eq (vla-get-HasAttributes bObj) :vlax-true)
     (setq pEnt
       (car (entsel "\nSelect Polyline: ")))
     (wcmatch
       (cdr (assoc 0 (entget pEnt))) "*POLYLINE"))
   (progn
     (vla-getBoundingBox
       (setq pObj
         (vlax-ename->vla-object pEnt)) 'MiP 'MaP)
     (mapcar
       (function
         (lambda (Obj)
           (putxdat Obj "LMACUPD"
             (vl-prin1-to-string
               (list
                 (vla-get-Handle pObj)
                   (vla-get-Handle bObj)))))) (list pObj bObj))
     (setq win (mapcar 'vlax-safearray->list (list MiP MaP))
           num (sslength
                 (ssget "_X"
                   (list
                     (cons 0 "INSERT")
                       (cons 2 (vla-get-Name bObj))
                         (cons 66 1)))))            
     (foreach Att (vlax-safearray->list
                    (vlax-variant-value
                      (vla-getAttributes bObj)))
       (cond
         ((eq ins (strcase (vla-get-TagString Att)))
          (vla-put-TextString Att
            (rtos num 2 0)))
         ((eq Wid (strcase (vla-get-TagString Att)))
          (vla-put-TextString Att
            (rtos
              (- (caadr win) (caar win)) 2 2)))
         ((eq Hgt (strcase (vla-get-TagString Att)))
          (vla-put-TextString Att
            (rtos
              (- (cadadr win) (cadar win)) 2 2))))))
   (princ "\n<< Incorrect Selection >>"))
 (princ))

(defun c:BlkUpdshow (/ gr ent xtyp xval Objlst)
 (while
   (and
     (setq gr (grread t 13 2))
     (eq 5 (car gr)))
   (if (setq ent (car (nentselp (cadr gr))))
     (progn
       (vla-getXdata
         (vlax-ename->vla-object ent) "LMACUPD" 'xtyp 'xval)
       (if (and xtyp xval)
         (mapcar
           (function
             (lambda (x)
               (redraw x 3)))
           (setq Objlst
             (mapcar 'handent
               (read
                 (vlax-variant-value
                   (cadr
                     (vlax-safearray->list xval)))))))))
         (if Objlst
           (mapcar
             (function
               (lambda (x)
                 (redraw x 4))) Objlst))))
 (princ))
           

(defun BlkUpdr (Reac Args / ins wid hgt blk ss xtyp xval hand
                           pObj MiP MaP bObj win num)

 ;;<<  Tag Names must be Capitalised! >>
 (setq ins "COUNT")         ;; << Instances Tag
 (setq Wid "X-WIDTH")       ;; << Width Tag
 (setq Hgt "Y-HEIGHT")      ;; << Height Tag
 
 (if (vl-position
       (car Args)
         '("GRIP_STRETCH"
           "GRIP_MOVE"
           "GRIP_SCALE"
           "GRIP_ROTATE"))
   (if (setq ss (cadr (ssgetfirst)))
     (progn
       (vla-getXdata
         (vlax-ename->vla-object
           (ssname ss 0)) "LMACUPD" 'xtyp 'xval)
       (if (and xtyp xval)
         (progn
           (setq hand
             (mapcar 'handent
               (read
                 (vlax-variant-value
                   (cadr
                     (vlax-safearray->list xval))))))
           (vla-getBoundingBox
             (setq pObj
               (vlax-ename->vla-object (car hand))) 'MiP 'MaP)
           (setq bObj (vlax-ename->vla-object (cadr hand))
                 win (mapcar 'vlax-safearray->list (list MiP MaP))
                 num (sslength
                       (ssget "_X"
                         (list
                           (cons 0 "INSERT")
                             (cons 2 (vla-get-Name bObj))
                               (cons 66 1)))))
           (foreach Att (vlax-safearray->list
                          (vlax-variant-value
                            (vla-getAttributes bObj)))
             (cond
               ((eq ins (strcase (vla-get-TagString Att)))
                (vla-put-TextString Att
                  (rtos num 2 0)))
               ((eq Wid (strcase (vla-get-TagString Att)))
                (vla-put-TextString Att
                  (rtos
                    (- (caadr win) (caar win)) 2 2)))
               ((eq Hgt (strcase (vla-get-TagString Att)))
                (vla-put-TextString Att
                  (rtos
                    (- (cadadr win) (cadar win)) 2 2)))))))))))          

(defun putxdat (Obj App Data / ent type1 valeur)

 (setq xtype
   (vlax-make-variant
     (vlax-safearray-fill
       (vlax-make-safearray
         vlax-vbInteger '(0 . 1)) '(1001 1000))))

 (setq xval
   (vlax-make-variant
     (vlax-safearray-fill
       (vlax-make-safearray
         vlax-vbVariant '(0 . 1)) (list App Data))))

 (vla-setXData Obj xtype xval))

(vl-load-com)
(if *lmac-Block*
 (vlr-remove *lmac-Block*)
 (setq *lmac-Block* nil))
(setq *lmac-Block*
 (vlr-command-Reactor nil
   (list
     (cons :vlr-CommandEnded 'BlkUpdr))))

Link to comment
Share on other sites

When I load it up though, i received this in the command window.

"Command: ; error: no function definition: VLR-COMMAND-REACTOR"

 

Seems that might be a problem? Although interesting how it works half the time :P

 

 

This is only a minor problem, as I forgot to load the VL functions on start-up :oops:

Link to comment
Share on other sites

It works half the time for me. Some blocks i apply it to, it'll update both of the attributes, and the grip movements update fine. Although other times it wont even give a measurement to one of the attributes.

 

When I load it up though, i received this in the command window.

"Command: ; error: no function definition: VLR-COMMAND-REACTOR"

 

Seems that might be a problem? Although interesting how it works half the time :P

 

User error here... noticed one of my attributes were not named correctly :P

 

Still thanks a ton! Works great now!

 

One last thing, anyway it could be modified to find the measurement up to 4 decimal places? :)

 

 

EDIT:

 

Figured out the the tolerances :)

 

Is there perhaps a way for it to grab the measurement in fractional form, then convert that measurement into decimal form to become the attribute?

 

I only ask because I ran into a bit of a problem where one dimension will be, for example, 7.8118 (7-13/16") instead of 7.8125 (7-13/16") and the decimal form is what i need [Drawings seem to come out inaccurate sometimes when putting in a fractional measurement, so the odd decimal conversion occurs :/]

Link to comment
Share on other sites

Hmmm... I'm not sure about that fractional form... - The code uses the GetBoundingBox method which just uses the coordinate system in place on the drawing - so I am not sure quite what to do at that point ... :oops:

Link to comment
Share on other sites

Thats alright, the point I've gotten to with your help has still helped me a ton!

 

I'll have it extract the information as a fraction, and I'll just convert the numbers once in excel. Still takes a ton of the work out of it

 

Thanks for all the work!

Link to comment
Share on other sites

Thats alright, the point I've gotten to with your help has still helped me a ton!

 

I'll have it extract the information as a fraction, and I'll just convert the numbers once in excel. Still takes a ton of the work out of it

 

Thanks for all the work!

 

No problem :)

 

I have also learnt a lot by this example :)

 

Lee

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...