;; Entnext to End - Lee Mac
;; Returns a list of all primary entities after a given entity in the drawing database
(defun LM:ENTNEXTTOEND
( ent
/ tmp
) (LM:entnexttoend tmp)
(cons tmp
(LM:entnexttoend tmp
)) )
)
)
;; Entlast - Lee Mac
;; Returns the last entity in the drawing database after a given entity
)
)
;; Block Reference Bounding Box - Lee Mac
;; Returns a WCS point list describing a rectangular frame bounding all geometry of a supplied block reference.
;; Excludes Text, MText & Attribute Definitions.
;; ref - [vla] Block Reference Object
(defun LM:blockreferenceboundingbox
(ref
) (
)
)
(refgeom (vlax-vla-object->ename ref))
)
)
(LM:blockdefinitionboundingbox
)
)
)
)
;; Block Definition Bounding Box - Lee Mac
;; Returns a WCS point list describing a rectangular frame bounding all geometry of a supplied block definition.
;; Excludes Text, MText & Attribute Definitions.
;; def - [vla] Block Definition Object
(defun LM:blockdefinitionboundingbox
(def
/ llp lst urp
) (setq lst
(append lst
(LM:blockreferenceboundingbox obj
))) )
"AcDbAttributeDefinition,AcDb*Text"
)
)
)
)
)
)
(vlax
-safearray
->list urp
) lst
)
)
)
)
)
(LM:points->boundingbox lst)
)
;; Point to Bounding Box - Lee Mac
;; Returns the rectangular extents of a supplied point list
(defun LM:points
->boundingbox
(lst
) '(
)
)
)
)
)
)
;; RefGeom (gile)
;; Returns a list which first item is a 3x3 transformation matrix (rotation, scales, normal)
;; and second item the object insertion point in its parent (xref, block or space)
;; Argument : an ename
(defun refgeom
(ent
/ ang ang mat ocs
) )
(mxm
'(
(1.0 0.0 0.0)
(0.0 1.0 0.0)
(0.0 0.0 1.0)
)
)
(mxm
'(0.0 0.0 1.0)
)
)
)
)
)
(mxv mat
)
)
)
)
;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n
)
;; Matrix Transpose - Doug Wilson
;; Args: m - nxn matrix
)
;; Matrix x Matrix - Vladimir Nesterovsky
;; Args: m,n - nxn matrices
)
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(defun C:BOTTOM
-HATCH
( / BOUNDARY
-SET BOUNDARY
-SET
-S BR
-BB BR
-EN BR
-ES BR
-OBJ DIAGONAL E
-BASE E
-DX
E
-DY E
-HEIGHT E
-LL E
-LR E
-PLINE
-V
-LIST E
-UL E
-UR H
-EN I I
-BASE I
-HEIGHT I
-LL
I-LR I-UL I-UR IND INT-LST J LL-BASE-PP N-X-DIV N-Y-DIV NEW-EN-LST OFFSET PI/4
PICK
-POINT
-LIST PPL PT SS
-TO
-ERASE X
-E
-LL
-O X
-ENTLAST X
-INT
-LST X
-LOWER
-PP
-LST
X-LOWER-PT-LST X-UPPER-PP-LST X-UPPER-PT-LST Y-E-LL-O Y-INT-LST Y-LEFT-PP-LST Y-LEFT-PT-LST
Y-RIGHT-PP-LST Y-RIGHT-PT-LST
)
; the insert must have ROTATION ANGLE = 0.0
; and CANNOT CONTAIN HATCHS and SPLINES
(setq br
-es
(entsel "\nselect the block to fill on the bottom :") ) (setq br
-bb
(LM:BLOCKREFERENCEBOUNDINGBOX br
-obj
) ) offset (/ i-height 20.0)
diagonal
(* offset
(sqrt 2.0) ) pi/4 (/ pi 4.0)
e
-ll
(polar i
-ll
(* pi
/4 5.0) diagonal
) e
-lr
(polar i
-lr
(* pi
/4 7.0) diagonal
) e
-ur
(polar i
-ur
(* pi
/4 1.0) diagonal
) e
-ul
(polar i
-ul
(* pi
/4 3.0) diagonal
) int-lst '(20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1)
; - - - - - - - - - - - - - - - -
n-y-div 6.0
e-dy (/ e-height n-y-div)
y
-e
-ll
-o
(polar e
-ll pi offset
) y
-right
-pt
-lst
(mapcar '
(lambda (i
) (polar i
0.0 (+ e
-base offset offset
) ) ) y
-left
-pt
-lst
)
; - - - - - - - - - - - - - - - -
n-x-div 6.0
e-dx (/ e-base n-x-div)
x
-e
-ll
-o
(polar e
-ll
(* pi
/4 6.0) offset
) x
-upper
-pt
-lst
(mapcar '
(lambda (i
) (polar i
(* pi
/4 2.0) (+ e
-height offset offset
) ) ) x
-lower
-pt
-lst
)
; - - - - - - - - - - - - - - - -
ll
-base
-pp
(polar e
-ll
(* pi
/4 6.0) (+ (/ e
-dy
2.0) ) ) ll
-base
-pp
(polar ll
-base
-pp
0.0 (* offset
0.5) ) y
-right
-pp
-lst
(mapcar '
(lambda (i
) (polar i
0.0 (+ i
-base offset
) ) ) y
-left
-pp
-lst
)
; - - - - - - - - - - - - - - - -
ll
-base
-pp
(polar e
-ll pi
(+ (/ e
-dx
2.0) ) ) ll
-base
-pp
(polar ll
-base
-pp
(* pi
/4 2.0) (/ offset
2.0) ) x
-upper
-pp
-lst
(mapcar '
(lambda (i
) (polar i
(* pi
/4 2.0) (+ i
-height offset
) ) ) x
-lower
-pp
-lst
)
)
)
t
)
(:ENTER_TO_CONTINUE)
(:ENTER_TO_CONTINUE)
'((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (8 . "0") (90 . 5) (70 . 1))
)
)
(:ENTER_TO_CONTINUE)
(:ENTER_TO_CONTINUE)
(:ENTER_TO_CONTINUE)
(vl-cmdf "_-bhatch" "_a" "_b" "_n" boundary
-set "" "") (:ENTER_TO_CONTINUE)
(:ENTER_TO_CONTINUE)
(command "HATCHGENERATEBOUNDARY" h
-en
"") (:ENTER_TO_CONTINUE)
(:ENTER_TO_CONTINUE)
(vl-cmdf "_-bhatch" "_a" "_b" "_n" ss
-to
-erase
"" "" (mid i
-ll i
-ur
) "") (:ENTER_TO_CONTINUE)
(:ENTER_TO_CONTINUE)
)
(defun c:K
() (C:BOTTOM
-HATCH
) )