lisp help me please

lisp help me please

Anonymous
Not applicable
675 Views
0 Replies
Message 1 of 1

lisp help me please

Anonymous
Not applicable

Hello boxcount need help with named lisp

I do not know english . I am writing with translation

This lisp extracts the table of the boxes measure in the drawing

only measure changed boxes chooses need to select all boxes.

formed table name and piece can it be added

 

;Counting boxes as 3dsolids
;- objects must be 3dsolid, in form of a box
;- the 3dsolids can be created using:
; - BOX command
; - Sweep or Extrude rectangles on a STRAIGHT path
; - Boolean operations, resulting a box
; Stefan M. - 24.11.2015
(defun c:boxcount ( / ss i a o l)
(if
(setq ss (ssget '((0 . "3DSOLID"))))
(progn
(repeat (setq i (sslength ss))
(if
(setq a (rec_geom (ssname ss (setq i (1- i)))))
(if
(setq o (vl-some
'(lambda (x)
(if
(and
(equal (car a) (car x) 1e-5)
(equal (cadr a) (cadr x) 1e-5)
)
x)
)
l
)
)
(setq l (subst (list (car a) (cadr a) (+ (caddr o) (caddr a))) o l))
(setq l (cons a l))
)
)
)

(if
(setq l (vl-sort
l
'(lambda (a b)
(if
(equal (car a) (car b) 1e-5)
(if
(equal (cadr a) (cadr b) 1e-5)
(< (caddr a) (caddr b))
(< (cadr a) (cadr b))
)
(< (car a) (car b))
)
)
)
)
(ins_table_boxescounting l)
)
)
)
(princ)
)

(defun rec_geom (e / v m a b c)
(setq e (vlax-ename->vla-object e)
v (vlax-get e 'Volume)
m (vlax-get e 'PrincipalMoments)
a (sqrt (/ (* 6.0 (+ (car m) (cadr m) (- (caddr m)))) v))
b (sqrt (/ (* 6.0 (+ (cadr m) (caddr m) (- (car m)))) v))
c (sqrt (/ (* 6.0 (+ (caddr m) (car m) (- (cadr m)))) v))
)
(if (equal (* a b c) v 1e-5) (vl-sort (list a b c) '<))
)

(defun ins_table_boxescounting (l / acobj acdoc space ht o tab i row col)
(setq acObj (vlax-get-acad-object)
acDoc (vla-get-activedocument acObj)
space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace))
ht (/ 2.2 (cond ((getvar 'cannoscalevalue)) (1.0)))
)
(if
(setq o (getpoint "\nSpecify table insertion point: "))
(progn
(setq tab (vla-addtable space (vlax-3d-point (trans o 1 0)) (+ 2 (length l)) 3 (* 2.5 ht) ht))
(vlax-put tab 'direction (trans '(1 0 0) 1 0 T))

(mapcar
(function
(lambda (rowType)
(vla-SetTextStyle tab rowType (getvar 'textstyle))
(vla-SetTextHeight tab rowType ht)
)
)
'(2 4 1)
)

(vla-put-HorzCellMargin tab (* 0.14 ht))
(vla-put-VertCellMargin tab (* 0.14 ht))

(setq l (cons (list "Width" "Height" "Length") l))

(setq i 0)
(foreach col (apply 'mapcar (cons 'list l))
(vla-SetColumnWidth tab i
(apply 'max
(mapcar
'(lambda (x)
((lambda (txb) (+ (abs (- (caadr txb) (caar txb))) (* 2.0 ht)))
(textbox
(list
(cons 1 (vl-princ-to-string x))
(cons 7 (getvar 'textstyle))
(cons 40 ht)
)
)
)
)
col
)
)
)
(setq i (1+ i))
)
(setq l (cons '("BOXES COUNTING") l))

(setq row 0)
(foreach r l
(setq col 0)
(vla-SetRowHeight tab row (* 1.5 ht))
(foreach c r
(vla-SetText tab row col (vl-princ-to-string c))
(setq col (1+ col))
)
(setq row (1+ row))
)
)
)
)
(princ "\n***** Type BOXCOUNT to start ******")

0 Likes
676 Views
0 Replies
Replies (0)