Jump to content

Enclose objects with rectangle

mdbdesign

By mdbdesign
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

  • Replies 43
  • Created
  • Last Reply

Top Posters In This Topic

  • Lee Mac

    14

  • sadhu

    12

  • vladthedog

    4

  • VovKa

    3

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

Lee Mac
Lee Mac

The sample program (c:test) included on that page provides an example of how to call the function from another program.

sadhu Collaborator

sadhu

Posted
Posted

Sorry, I was quite inaccurate. I used it in LAYOUT - PAPER SPACE in "maximise viewport" and there it doesn't work. I did not get any error - no box appeared.

 

I tried it now again in MODEL SPACE and it worked perfectly. Thanks again.

 

Can you help me with this :

 

what I am looking for is to draw a box around selected objects and number it. The numbering should be progressive / incremental and I should be able to continue numbering even after I close the drawing and reopen it later.

 

The boxes are outlet boxes on an electrical floor plan. The boxes enclose objects like switches, sockets etc. These boxes have to be numbered. When new boxes are added to the dwg they have to have different numbers.

 

Thanks.

 

I tried your numbering programs too. Will it be possible to put the two togather ?

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
I tried your numbering programs too. Will it be possible to put the two togather ?

 

I'm guessing you are referring to 'NumInc' and 'AutoNum' right?

 

Yeah, Version 3 is the original AutoNum program, and Version 4 of AutoNum has been combined with NumInc. :)

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

Ok, I have updated my previous code to account for when you are operating through a custom viewport. :)

 

what I am looking for is to draw a box around selected objects and number it. The numbering should be progressive / incremental and I should be able to continue numbering even after I close the drawing and reopen it later.

 

The boxes are outlet boxes on an electrical floor plan. The boxes enclose objects like switches, sockets etc. These boxes have to be numbered. When new boxes are added to the dwg they have to have different numbers.

 

A few questions on this:

 

  • Where on the box should the number be placed?

  • If a box is deleted at some point, do all the numbers > the box number get shifted decremented?

  • Will all the boxes/numbers be on a certain layer (makes life easier), if so, which? (or should I make one up?)

Lee

Link to comment
Share on other sites
sadhu Collaborator

sadhu

Posted
Posted

  • The number should be outside the box - aligned center or right . I often rotate the box and its contents so that it aligns to walls.
  • No, if a box is eliminated the numbers do not have to be decremented. I use the numbers to identify the boxes.
  • The box numbers can be on a different layer - you can make up the layer. When I move or rotate the box (and contents) the number too will move.

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

Try this:

 

(defun c:BoxObj (/ *error* LWPoly Text

                  ENT FLOOR I LAY MA MI NNUM NUM PTS SS UFLAG)
 (vl-load-com) ;; Lee Mac  ~  11.02.10

 (setq lay "My Boxing Layer")

 (defun *error* (msg)
   (and uFlag (vla-EndUndomark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))
 
 (defun LWPoly (lst cls)
   (entmakex (append (list (cons 0 "LWPOLYLINE")
                           (cons 100 "AcDbEntity")
                           (cons 100 "AcDbPolyline")
                           (cons 8 lay)
                           (cons 90 (length lst))
                           (cons 70 cls))
                     (mapcar (function (lambda (p) (cons 10 p))) lst))))

 (defun Text (pt hgt str)
   (entmakex (list (cons 0 "TEXT")
                   (cons 8 lay)
                   (cons 10  pt)
                   (cons 40 hgt)
                   (cons 1  str)
                   (cons 72 1)
                   (cons 73 2)
                   (cons 11 pt))))

 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object)))))
 
 (if (setq ss (ssget))
   (progn
     (setq uFlag (not (vla-StartUndoMark *doc)))
     
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *doc))
       
       (vla-getBoundingbox obj 'Mi 'Ma)
       (setq pts (cons (vlax-safearray->list Mi)
                       (cons (vlax-safearray->list Ma) pts))))
     (vla-delete ss)
     (setq Mi (apply (function mapcar) (cons 'min pts))
           Ma (apply (function mapcar) (cons 'max pts)))

     (LwPoly (list Mi (list (car Mi) (cadr Ma) 0.) Ma
                      (list (car Ma) (cadr Mi) 0.)) 1)

     (setq num
       (if (setq i -1 floor 1 ss (ssget "_X" (list (cons 0 "TEXT") (cons 8 lay))))
         (progn
           (while (setq ent (ssname ss (setq i (1+ i))))
             (if (< floor (setq nNum (atoi (cdr (assoc 1 (entget ent))))))
               (setq floor nNum)))

           (itoa (1+ floor))) "1"))

     (Text Mi (getvar 'TEXTSIZE) num)
     
     (setq uFlag (vla-EndUndoMark *doc))))      

 (princ))

 

Code updated.

Link to comment
Share on other sites
sadhu Collaborator

sadhu

Posted
Posted

I've just tried it. It is really good.:D

Thankx.

 

How does the scale/size of the numbering work ? In some of my drawings they are really small while in some others they are too large. How can I adjust the scale/size ?

 

Can you add an offset to the box. In many cases I need to draw around another box-like-object and it overwrites.

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

Settings at the top, highlighted:

 

(defun c:BoxObj (/ *error* LWPoly Text

                  ENT FLOOR I LAY MA MI NNUM NUM OFFSET PTS SS THGT UFLAG)
 
 (vl-load-com) ;; Lee Mac  ~  11.02.10
[b][color=Red]
 (setq lay "My Boxing Layer" ;; Layer

       offset 5.  ;; Offset

       thgt (getvar "TEXTSIZE")) ;; Text Height[/color][/b]

 (defun *error* (msg)
   (and uFlag (vla-EndUndomark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))
 
 (defun LWPoly (lst cls)
   (entmakex (append (list (cons 0 "LWPOLYLINE")
                           (cons 100 "AcDbEntity")
                           (cons 100 "AcDbPolyline")
                           (cons 8 lay)
                           (cons 90 (length lst))
                           (cons 70 cls))
                     (mapcar (function (lambda (p) (cons 10 p))) lst))))

 (defun Text (pt hgt str)
   (entmakex (list (cons 0 "TEXT")
                   (cons 8 lay)
                   (cons 10  pt)
                   (cons 40 hgt)
                   (cons 1  str)
                   (cons 72 1)
                   (cons 73 2)
                   (cons 11 pt))))

 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object)))))
 
 (if (setq ss (ssget))
   (progn
     (setq uFlag (not (vla-StartUndoMark *doc)))
     
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *doc))
       
       (vla-getBoundingbox obj 'Mi 'Ma)
       (setq pts (cons (vlax-safearray->list Mi)
                       (cons (vlax-safearray->list Ma) pts))))
     (vla-delete ss)
     (setq Mi (apply (function mapcar) (cons 'min pts))
           Ma (apply (function mapcar) (cons 'max pts)))

     (LwPoly (list (list (- (car Mi) offset)
                         (- (cadr Mi) Offset) 0.)
                   (list (- (car Mi) offset)
                         (+ (cadr Ma) offset) 0.)
                   (list (+ (car Ma) offset)
                         (+ (cadr Ma) offset) 0.)
                   (list (+ (car Ma) offset)
                         (- (cadr Mi) offset) 0.)) 1)

     (setq num
       (if (setq i -1 floor 1 ss (ssget "_X" (list (cons 0 "TEXT") (cons 8 lay))))
         (progn
           (while (setq ent (ssname ss (setq i (1+ i))))
             (if (< floor (setq nNum (atoi (cdr (assoc 1 (entget ent))))))
               (setq floor nNum)))

           (itoa (1+ floor))) "1"))

     (Text (list (- (car Mi) offset)
                 (- (cadr Mi) Offset) 0.) thgt num)
     
     (setq uFlag (vla-EndUndoMark *doc))))      

 (princ))

Link to comment
Share on other sites
sadhu Collaborator

sadhu

Posted
Posted
(setq lay "My Boxing Layer" ;; Layer

 

offset 5. ;; Offset

 

thgt (getvar "TEXTSIZE")) ;; Text Height

Offset works fine. I couldn't get TEXTSIZE to work but that could be my fault.:oops:

 

Do I have to put a value in place of "TEXTSIZE" ? Where do I put the text height value?

 

Can the text (number) be positioned completely outside the box ? Currently the text is centered on the vertex of the box.

 

:D

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

How about this?

 

(defun c:BoxObj (/ *error* LWPoly Text

                  ENT FLOOR I LAY MA MI NNUM NUM OFFSET PTS SS THGT UFLAG)
 
 (vl-load-com) ;; Lee Mac  ~  11.02.10

 (setq lay "My Boxing Layer" ;; Layer

       offset 5.  ;; Offset

       thgt 2.5   ;; Text Height

 )

 (defun *error* (msg)
   (and uFlag (vla-EndUndomark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))
 
 (defun LWPoly (lst cls)
   (entmakex (append (list (cons 0 "LWPOLYLINE")
                           (cons 100 "AcDbEntity")
                           (cons 100 "AcDbPolyline")
                           (cons 8 lay)
                           (cons 90 (length lst))
                           (cons 70 cls))
                     (mapcar (function (lambda (p) (cons 10 p))) lst))))

 (defun Text (pt hgt str)
   (entmakex (list (cons 0 "TEXT")
                   (cons 8 lay)
                   (cons 10  pt)
                   (cons 40 hgt)
                   (cons 1  str)
                   (cons 72 1)
                   (cons 73 2)
                   (cons 11 pt))))

 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object)))))
 
 (if (setq ss (ssget))
   (progn
     (setq uFlag (not (vla-StartUndoMark *doc)))
     
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *doc))
       
       (vla-getBoundingbox obj 'Mi 'Ma)
       (setq pts (cons (vlax-safearray->list Mi)
                       (cons (vlax-safearray->list Ma) pts))))
     (vla-delete ss)
     (setq Mi (apply (function mapcar) (cons 'min pts))
           Ma (apply (function mapcar) (cons 'max pts)))

     (LwPoly (list (list (- (car Mi) offset)
                         (- (cadr Mi) Offset) 0.)
                   (list (- (car Mi) offset)
                         (+ (cadr Ma) offset) 0.)
                   (list (+ (car Ma) offset)
                         (+ (cadr Ma) offset) 0.)
                   (list (+ (car Ma) offset)
                         (- (cadr Mi) offset) 0.)) 1)

     (setq num
       (if (setq i -1 floor 1 ss (ssget "_X" (list (cons 0 "TEXT") (cons 8 lay))))
         (progn
           (while (setq ent (ssname ss (setq i (1+ i))))
             (if (< floor (setq nNum (atoi (cdr (assoc 1 (entget ent))))))
               (setq floor nNum)))

           (itoa (1+ floor))) "1"))

     (Text (list (- (car Mi)  (+ offset tHgt))
                 (- (cadr Mi) (+ Offset tHgt)) 0.) thgt num)
     
     (setq uFlag (vla-EndUndoMark *doc))))      

 (princ))

Link to comment
Share on other sites
sadhu Collaborator

sadhu

Posted
Posted

The last code works fine. Really thanks a lot. :D

 

I just need to adjust the position of the text/number. Can you place it outside and under the center of the box side . Often there are several boxes aligned so I need to place the number below the box .

 

Can you group the entire selection ( box, contents and the number) so that when i need to move or rotate it I just click on it once. Make it one object. :D

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
The last code works fine. Really thanks a lot. :D

 

I just need to adjust the position of the text/number. Can you place it outside and under the center of the box side . Often there are several boxes aligned so I need to place the number below the box .

 

Can you group the entire selection ( box, contents and the number) so that when i need to move or rotate it I just click on it once. Make it one object. :D

 

You don't ask for much...

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

Something like this?

 

(defun c:BoxObj (/ *error* LWPoly Text

                  ENT FLOOR GRP I LAY MA MI NNUM NUM
                  OFFSET POLY PTS SS THGT TOBJ UFLAG)
 
 (vl-load-com) ;; Lee Mac  ~  11.02.10

 (setq lay "My Boxing Layer" ;; Layer

       offset 5.  ;; Offset

       thgt 2.5   ;; Text Height

 )

 (defun *error* (msg)
   (and uFlag (vla-EndUndomark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))
 
 (defun LWPoly (lst cls)
   (entmakex (append (list (cons 0 "LWPOLYLINE")
                           (cons 100 "AcDbEntity")
                           (cons 100 "AcDbPolyline")
                           (cons 8 lay)
                           (cons 90 (length lst))
                           (cons 70 cls))
                     (mapcar (function (lambda (p) (cons 10 p))) lst))))

 (defun Text (pt hgt str)
   (entmakex (list (cons 0 "TEXT")
                   (cons 8 lay)
                   (cons 10  pt)
                   (cons 40 hgt)
                   (cons 1  str)
                   (cons 72 1)
                   (cons 73 2)
                   (cons 11 pt))))

 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object)))))
 
 (if (setq ss (ssget))
   (progn
     (setq uFlag (not (vla-StartUndoMark *doc)))
     
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *doc))
       
       (vla-getBoundingbox obj 'Mi 'Ma)
       (setq pts (cons (vlax-safearray->list Mi)
                       (cons (vlax-safearray->list Ma) pts))))
     (vla-delete ss)
     (setq Mi (apply (function mapcar) (cons 'min pts))
           Ma (apply (function mapcar) (cons 'max pts)))

     (setq Poly
       (LwPoly (list (list (- (car Mi) offset)
                           (- (cadr Mi) Offset) 0.)
                     (list (- (car Mi) offset)
                           (+ (cadr Ma) offset) 0.)
                     (list (+ (car Ma) offset)
                           (+ (cadr Ma) offset) 0.)
                     (list (+ (car Ma) offset)
                           (- (cadr Mi) offset) 0.)) 1))

     (setq num
       (if (setq i -1 floor 1 ss (ssget "_X" (list (cons 0 "TEXT") (cons 8 lay))))
         (progn
           (while (setq ent (ssname ss (setq i (1+ i))))
             (if (< floor (setq nNum (atoi (cdr (assoc 1 (entget ent))))))
               (setq floor nNum)))

           (itoa (1+ floor))) "1"))

     (setq TObj
       (Text (list (/ (+ (car Mi) (car Ma)) 2.)
                   (- (cadr Mi) (+ Offset tHgt)) 0.) thgt num))

     (if (not (vl-catch-all-error-p
                (setq Grp
                  (vl-catch-all-apply
                    (function vla-Add)
                      (list (vla-get-Groups *doc) (strcat "BoxNumber_" num))))))
       
       (vla-AppendItems Grp
         (vlax-make-variant
           (vlax-safearray-fill
             (vlax-make-safearray
               vlax-vbObject '(0 . 1))
             (mapcar
               (function vlax-ename->vla-object) (list Poly tObj)))))

       (princ (strcat "\n** Error Creating Group: "
                      (vl-catch-all-error-message Grp) " **")))
     
     (setq uFlag (vla-EndUndoMark *doc))))      

 (princ))

 

I've never worked with Groups before, so you may have to check that part. :)

Link to comment
Share on other sites
sadhu Collaborator

sadhu

Posted
Posted

Thanks Lee. You are a Guru.:D

 

 

I am using three programs to do what I need to do. Openoffice Calc (similar to MS Excel), Autocad and another cad program. Maybe now I can reduce thyem to two - autocad and Calc.

Link to comment
Share on other sites
  • 10 years later...

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.

×
 Share
Go to topic listing
×
×
  • Create New...