;;; Calculate Real Paper Size (Effective Inked Area Only) for All Layouts
;;; Created by Igal Averbuh 2016 (combined from many routines of many authors)
;;; With great respect to Henrique http://forums.autodesk.com/t5/user/viewprofilepage/user-id/75977

;;; LISP to unload all XREF's,and IMAGE's

(defun c:ua (/)
(vl-load-com)
(vl-cmdf "_.-xref" "u" "*")
(vl-cmdf "_.-image" "u" "*")
(princ)
)

;;; LISP to reload all XREF's,and IMAGE's

(defun c:ra (/)
(vl-load-com)
(setvar "visretain" 1)
(vl-cmdf "_.-xref" "r" "*")
(vl-cmdf "_.-image" "r" "*")
(princ)
)

(command "-layer" "m" "0-PAGE_DIM_TEMP" "")
((lambda (/ _dimstyle-setup)
(defun _dimstyle-setup (/)
(mapcar 'eval
'(
(SETVAR "DIMADEC" 0)
(SETVAR "DIMALT" 0)
(SETVAR "DIMALTD" 2)
(SETVAR "DIMALTF" 25.4)
(SETVAR "DIMALTRND" 0.0)
(SETVAR "DIMALTTD" 2)
;
; ... All your variables.
;
(SETVAR "DIMTXT" 5)
(SETVAR "DIMTZIN" 0)
(SETVAR "DIMUPT" 0)
(SETVAR "DIMZIN" 8)
)
)
)

(if (tblsearch "DIMSTYLE" "igal")
(progn
;; if the dimstyle exists
;; make sure its setup properly
(_dimstyle-setup)
;; set it current
(command "-dimstyle" "r" "igal")
)
(progn
;; otherwise
;; set it up properly
(_dimstyle-setup)
;; save it.
(command "-dimstyle" "s" "igal")
)
)
)
)

;; Selection Set Bounding Box - Lee Mac
;; Returns a list of the lower-left and upper-right WCS coordinates of a
;; rectangular frame bounding all objects in a supplied selection set.
;; s - [sel] Selection set for which to return bounding box

(defun LM:ssboundingbox (s / a b i m n o)
(repeat (setq i (sslength s))
(if
(and
(setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
(vlax-method-applicable-p o 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
)
(setq m (cons (vlax-safearray->list a) m)
n (cons (vlax-safearray->list b) n)
)
)
)
(if (and m n)
(mapcar '(lambda (a b) (apply 'mapcar (cons a b))) '(min max) (list m n))
)
)

(defun c:Dm (/ s) ; b -> as global variable
(command "select" "all" "")
(if (and (setq s (ssget "P"))
(setq b (LM:ssboundingbox s))
)
(command "_.DIMLINEAR"
"_none"
(car b)
"_none"
(list (caadr b) (cadar b))
"_none"
"@0,-2"
"_.DIMLINEAR"
"_none"
(list (caadr b) (cadar b))
"_none"
(cadr b)
"_none"
"@2,0"
)
)
(princ)
)

(vl-load-com)

;;; Dimmensions For All Layouts ( based on _gile program)
(defun c:REA (/ *error* acad acdoc aclay b file ht layt wd)
(vl-load-com)
(defun *error* (msg)
(if file
(close file)
)
(cond ((not msg))
((member msg '("Function cancelled" "quit / exit abort")))
((princ (strcat "\n** Error: " msg " ** ")))
)
(princ)
)
(setq acad (vlax-get-acad-object)
acdoc (vla-get-ActiveDocument acad)
aclay (vla-get-ActiveLayout acdoc)

file (open (strcat (getvar 'DWGPREFIX) (vl-filename-base (getvar 'DWGNAME)) "_Papers.txt") "w")
file1 (strcat (getvar 'DWGPREFIX) (vl-filename-base (getvar 'DWGNAME)) "_Papers.txt")
)
(write-line "Layout\tWidth\tHeight" file)
(vlax-for layout (vla-get-Layouts acdoc)
(vla-put-ActiveLayout acdoc layout)
(command "_.PSPACE")
(c:dm)
(setq wd (rtos (distance (car b) (list (caadr b) (cadar b))) 2 2)
ht (rtos (distance (list (caadr b) (cadar b)) (cadr b)) 2 2)
layt (vla-get-name layout)
)

(write-line (strcat layt "\t" wd "\t" ht) file)
)
(vla-put-ActiveLayout acdoc aclay)
(*error* nil)
(startapp "notepad.exe" file1)
(princ)
)
(c:ua)
(c:rea)
(c:ra)

Advertisements