Jump to content

Block by windowing lisp


BrianTFC

Recommended Posts

Hi All,

 

What i'm looking to do is block multiple objects by windowing all of them at once and have them save as sepearate blocks and using the label in the middle as the block name. I guess the big question is it even possible to do this?

 

 

Brian

block dwg.dwg

Link to comment
Share on other sites

  • Replies 30
  • Created
  • Last Reply

Top Posters In This Topic

  • BrianTFC

    15

  • Tharwat

    14

  • Lee Mac

    2

I guess it is possible since that you have a polyline all around the objects within .

 

But what's if there wasn't any text within that outside polyline to be the block name ? besides that , the text may have the same string ,

what would be the block name for the second block name ?

Link to comment
Share on other sites

They will always have a text label inside the polyline. The labels will always be different, i sorry i forgot to change the labels in my drawing after i copied them over.

Link to comment
Share on other sites

Try this code Brian and I hope it would meet your needs .

 

(defun c:Test (/ *error* s i sad sn ss cm j ssn st p p1 p2 k)
 (vl-load-com)
;;; Tharwat 20. March. 2013 ;;;
 (defun *error* (x)
   (if cm
     (setvar 'cmdecho cm)
   )
   (princ "\n*Cancel*")
 )
 (if (setq s (ssget "_:L"))
   (repeat (setq i (sslength s))
     (setq sn (ssname s (setq i (1- i))))
     (if (eq (cdr (assoc 0 (entget sn))) "LWPOLYLINE")
       (progn
         (setq sad nil)
         (vla-getboundingbox (vlax-ename->vla-object sn) 'a 'b)
         (setq p (mapcar '(lambda (m n) (/ (+ m n) 2.))
                         (setq p1 (vlax-safearray->list a))
                         (setq p2 (vlax-safearray->list b))
                 )
               k 0
         )
         (if (setq ss (ssget "_CP"
                             (list p1
                                   (list (car p1) (cadr p2))
                                   p2
                                   (list (car p2) (cadr p1))
                             )
                      )
             )
           (progn (setq cm  (getvar 'cmdecho)
                        sad (ssadd)
                  )
                  (setvar 'cmdecho 0)
                  (repeat (setq j (sslength ss))
                    (setq ssn (ssname ss (setq j (1- j))))
                    (ssadd ssn sad)
                    (if (wcmatch (cdr (assoc 0 (entget ssn))) "*TEXT")
                      (setq st (cdr (assoc 1 (entget ssn))))
                    )
                  )
                  (while (tblsearch "BLOCK" st)
                    (setq st (strcat st (itoa (setq k (1+ k)))))
                  )
                  (ssadd sn sad)
                  (vl-cmdf "_.-block" st "_non" p sad "")
                  (setvar 'cmdecho cm)
           )
         )
       )
     )
   )
   (princ)
 )
 (princ)
)

Link to comment
Share on other sites

Tharwat,

 

That works great Thanks, i notice if i have more than one text string in each rectangle it makes multiple block copies. Is there a way to have it use the DTEXT label as the file name and not the other MTEXT letters in the rectangle?

 

Brian

Link to comment
Share on other sites

Tharwat,

 

That works great Thanks

Brian

 

You're welcome Brian . :)

 

i notice if i have more than one text string in each rectangle it makes multiple block copies. Is there a way to have it use the DTEXT label as the file name and not the other MTEXT letters in the rectangle?

 

Yes sure , just remove the asterisk from the line of code from the routine .

(if (wcmatch (cdr (assoc 0 (entget ssn))) "[color=blue][b]*[/b][/color]TEXT")

 

Good luck .

Link to comment
Share on other sites

Tharwat,

 

That did the trick...I want to THANK YOU so much this save hours of work. :D

 

Brian

 

You're welcome .

 

I am very happy to hear that Brian . :)

Link to comment
Share on other sites

Tharwat,

 

I was wondering if you could modify the lisp to WBLOCK them instead of just blocking them.

 

Thanks for all of your help.:D

Brian

Link to comment
Share on other sites

I was wondering if you could modify the lisp to WBLOCK them instead of just blocking them.

 

Hi Brian .

 

Please try this code and let me know how it goes .

 

(defun c:Test (/ doc *error* s i sad sn ss cm j ssn st p p1 p2 k lst ss l)
 (vl-load-com)
;;; Tharwat 27. March. 2013 ;;;
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (defun *error* (x)
   (if cm
     (setvar 'cmdecho cm)
   )
   (princ "\n*Cancel*")
 )
 (if (setq s (ssget "_:L"))
   (repeat (setq i (sslength s))
     (setq sn (ssname s (setq i (1- i))))
     (if (eq (cdr (assoc 0 (entget sn))) "LWPOLYLINE")
       (progn (setq sad nil)
              (vla-getboundingbox (vlax-ename->vla-object sn) 'a 'b)
              (setq p (mapcar '(lambda (m n) (/ (+ m n) 2.))
                              (setq p1 (vlax-safearray->list a))
                              (setq p2 (vlax-safearray->list b))
                      )
                    k 0
              )
              (if (setq ss (ssget "_CP" (list p1 (list (car p1) (cadr p2)) p2 (list (car p2) (cadr p1)))))
                (progn (setq cm  (getvar 'cmdecho)
                             sad (ssadd)
                       )
                       (setvar 'cmdecho 0)
                       (repeat (setq j (sslength ss))
                         (setq ssn (ssname ss (setq j (1- j))))
                         (ssadd ssn sad)
                         (if (wcmatch (cdr (assoc 0 (entget ssn))) "TEXT")
                           (setq st (cdr (assoc 1 (entget ssn))))
                         )
                       )
                       (while (tblsearch "BLOCK" st) (setq st (strcat st (itoa (setq k (1+ k))))))
                       (ssadd sn sad)
                       (vl-cmdf "_.-block" st "_non" p sad "")
                       (if st
                         (setq lst (cons st lst))
                       )
                       (setvar 'cmdecho cm)
                )
              )
       )
     )
   )
   (princ)
 )
 (if lst
   (progn (foreach b lst
            (setq
              l (cons (entmakex (list '(0 . "INSERT") (list 10 0. 0. 0.) (cons 2 b) '(41 . 1.0) '(42 . 1.0) '(43 . 1.0)))
                      l
                )
            )
          )
          (foreach x lst
            (if (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 x))))
              (vla-wblock doc (strcat (getvar 'dwgprefix) x ".dwg") (vla-get-activeselectionset doc))
            )
          )
          (if l
            (mapcar 'entdel l)
          )
   )
 )
 (princ "\nWritten by Tharwat Al Shoufi")
 (princ)
)

Link to comment
Share on other sites

Tharwat,

 

I hate to ask but can you add an alert: ".dwg already exists in the current directory!!!" if try to save it again?

 

Thanks,

Brian

Link to comment
Share on other sites

I hate to ask ....

 

No worries Brian , as long as I have the ability to write the code , I won't hesitate to help you at all . :)

 

Please try this modified lisp and hope you like the idea of the code . [ untested code ] .

 

(defun c:Test
      (/ doc *error* s i sad sn ss cm j ssn st p p1 p2 k lst ss l)
 (vl-load-com)
;;; Tharwat 27. March. 2013 ;;;
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (defun *error* (x)
   (if cm
     (setvar 'cmdecho cm)
   )
   (princ "\n*Cancel*")
 )
 (if (setq s (ssget "_:L"))
   (repeat (setq i (sslength s))
     (setq sn (ssname s (setq i (1- i))))
     (if (eq (cdr (assoc 0 (entget sn))) "LWPOLYLINE")
       (progn
         (setq sad nil)
         (vla-getboundingbox (vlax-ename->vla-object sn) 'a 'b)
         (setq p (mapcar '(lambda (m n) (/ (+ m n) 2.))
                         (setq p1 (vlax-safearray->list a))
                         (setq p2 (vlax-safearray->list b))
                 )
               k 0
         )
         (if (setq ss (ssget "_CP"
                             (list p1
                                   (list (car p1) (cadr p2))
                                   p2
                                   (list (car p2) (cadr p1))
                             )
                      )
             )
           (progn
             (setq cm  (getvar 'cmdecho)
                   sad (ssadd)
             )
             (setvar 'cmdecho 0)
             (repeat (setq j (sslength ss))
               (setq ssn (ssname ss (setq j (1- j))))
               (ssadd ssn sad)
               (if (wcmatch (cdr (assoc 0 (entget ssn))) "TEXT")
                 (setq st (cdr (assoc 1 (entget ssn))))
               )
             )
             (while (tblsearch "BLOCK" st)
               (setq st (strcat st (itoa (setq k (1+ k)))))
             )
             (ssadd sn sad)
             (if
               (not (findfile (strcat (getvar 'dwgprefix) st ".dwg")))
                (progn
                  (vl-cmdf "_.-block" st "_non" p sad "")
                  (setq lst (cons st lst))
                )
                (alert (strcat "<!> The name of the drawing < "
                               st
                               " > is already exists <!> "
                       )
                )
             )
             (setvar 'cmdecho cm)
           )
         )
       )
     )
   )
   (princ)
 )
 (if lst
   (progn
     (foreach b lst
       (setq l (cons (entmakex (list '(0 . "INSERT")
                                     (list 10 0. 0. 0.)
                                     (cons 2 b)
                                     '(41 . 1.0)
                                     '(42 . 1.0)
                                     '(43 . 1.0)
                               )
                     )
                     l
               )
       )
     )
     (foreach x lst
       (if (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 x))))
         (vla-wblock
           doc
           (strcat (getvar 'dwgprefix) x ".dwg")
           (vla-get-activeselectionset doc)
         )
       )
     )
     (if l
       (mapcar 'entdel l)
     )
   )
 )
 (princ "\nWritten by Tharwat Al Shoufi")
 (princ)
)

Edited by Tharwat
Link to comment
Share on other sites

Tharwat,

 

Is there a way for it to check to see if the drawing already exists before it blocks the item? by the time it gets to wblock its already been made a block and has disappeared off my screen. i would like for it to stop the block process if it finds that the drawing already exists, is this possible?:unsure:

 

Thanks,

Brian

Link to comment
Share on other sites

Tharwat,

 

Is there a way for it to check to see if the drawing already exists before it blocks the item?

 

Sure , and the following code would check if the drawing is already existed in the same path which is come from the system variable 'dwgprefix .

 

(not (findfile (setq fl (strcat (getvar 'dwgprefix) x ".dwg"))))

Link to comment
Share on other sites

this is true but it still blocking the item before it gets to this line of code.

(not (findfile (setq fl (strcat (getvar 'dwgprefix) x ".dwg"))))

Link to comment
Share on other sites

this is true but it still blocking the item before it gets to this line of code.

(not (findfile (setq fl (strcat (getvar 'dwgprefix) x ".dwg"))))

 

Does it mean that you don't want the code to block the objects if the future name of the block being found in the dwgprefix path ?

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