Jump to content

Recommended Posts

Posted
BoxObj does not draw around selected objects - unless you intended some other use for it that I didn't understand.

 

It does in my tests - do you get an error?

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 ?

Posted

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

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

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

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.

Posted

Ok, thank you for the clarification, I will get back to you when I get a spare minute :)

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.

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.

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

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

Posted

(getvar 'TEXTSIZE) means it will get the value of the TEXTSIZE Sys Var and use that.

 

You will need to replace that whole part, ie.

 

tHgt 5.0)

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

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

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

Posted

I swear it was't easy asking. o:):oops:

 

It must have been a lot of work and I thank you for it.

 

A few clues on how to proceed would be helpful. :oops:

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

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.

  • 10 years later...
Posted

Hi

Can you edit lisp for item by item

Mean if select two object create 2 rectangle??

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