Scribd
Upload
8 views1 page

AutoCAD Block Creation Script

The document contains a Lisp routine for AutoCAD that creates a block from a selected set of objects and inserts it at a specified location. It includes error handling and calculates the bounding box of the selected objects to determine the insertion point. The program was created in May 2008 by a user named 'wizman'.

Uploaded by

sab_salih
Copyright
© All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as PDF, TXT or read online on Scribd
8 views1 page

AutoCAD Block Creation Script

The document contains a Lisp routine for AutoCAD that creates a block from a selected set of objects and inserts it at a specified location. It includes error handling and calculates the bounding box of the selected objects to determine the insertion point. The program was created in May 2008 by a user named 'wizman'.

Uploaded by

sab_salih
Copyright
© All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as PDF, TXT or read online on Scribd

(defun c:QBLOCK (/ *error* myset i b ll_pt)

(defun *error* (msg)


(if (and msg
(not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*"))
)
(princ (strcat "\nError: " msg))
) ;_ end of if
(princ)
) ;_ end of defun
(vl-load-com)
(setq myset (ssget))
(BBS)
(setq i 1
b (strcat "Block" (itoa i))
) ;_ end of setq
(while (tblsearch "BLOCK" b)
(setq b (strcat "Block" (itoa (setq i (1+ i)))))
) ;_ end of while
(command "_.-block" b ll_pt myset "")
(command "_.-insert" b ll_pt "" "" "")
(princ)
) ;_ end of defun

;;;***********************************************************************************
;;;PROGRAM CREATED FOR SELECTION SET BOUNDARY
;;;DATE: MAY 2008
;;;BY: wizman
;;; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

(defun BBS (/ all_min all_max maxpt minpt ur_pt)


(setq all_min '()
all_max '()
)
(foreach x
(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp
(mapcar 'cadr (ssnamex myset))
)
)
(vla-getboundingbox x 'minpt 'maxpt)
(setq all_min
(cons (trans (vlax-safearray->list minpt) 1 0) all_min)
)
(setq all_max
(cons (trans (vlax-safearray->list maxpt) 1 0) all_max)
)
) ;_ end_foreach
(setq ll_pt (list (car (vl-sort (mapcar 'car all_min) '<))
(car (vl-sort (mapcar 'cadr all_min) '<))
)
)
(setq ur_pt (list (last (vl-sort (mapcar 'car all_max) '<))
(last (vl-sort (mapcar 'cadr all_max) '<))
)
)
)

You might also like