- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello, rehashing an old lisp ported by the owner. I would like to add the option to put a light in the center of the room. with an array of high hat/can lights around it.
;;------------------=={ Custom Block Array }==----------------;;
;; ;;
;; Program will generate a rectangular array of a selected ;;
;; block with a specified number of rows and columns, with ;;
;; blocks spaced uniformly and aligned centrally between two ;;
;; window corner points selected by the user. ;;
;; ;;
;; Upon calling the program, the user is prompted to select ;;
;; a block to be arrayed. Following a valid selection, the ;;
;; user is then prompted to specify the number of rows and ;;
;; columns for the array, with the previously entered ;;
;; figures available as default values. ;;
;; ;;
;; A prompt then asks the user whether grid-lines are to ;;
;; be constructed, such grid-lines intersect at the ;;
;; insertion points of each block in the array and extend ;;
;; to the limits set by the selected corner points. ;;
;; ;;
;; The user is then prompted to pick two corner points of an ;;
;; array window, and the selected block is arrayed evenly ;;
;; between these points, with equal spacing. ;;
;; ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Version 1.1 - 14-09-2011 ;;
;;------------------------------------------------------------;;
(defun c:bArray
(
/
*error* _StartUndo _EndUndo _SelectIf
acdoc bl hd layer msg p0 p1 p2 p3 p4 vd x1 xd yd
)
;;------------------------------------------------------------;;
(setq layer "EST_E_LIGHTING-CONSTRUCION-LINES") ;; Layer for Grid Lines (created if not present)
;;------------------------------------------------------------;;
(defun *error* ( msg )
(if acdoc (_EndUndo acdoc))
(if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(defun _StartUndo ( doc )
(_EndUndo doc)
(vla-StartUndoMark doc)
)
(defun _EndUndo ( doc )
(if (= 8 (logand 8 (getvar 'UNDOCTL)))
(vla-EndUndoMark doc)
)
)
(defun _SelectIf ( msg pred )
(
(lambda ( pred / sel )
(while
(progn (setvar 'ERRNO 0) (setq sel (car (entsel msg)))
(cond
( (= 7 (getvar 'ERRNO))
(princ "\nMissed, Try again.")
)
( (eq 'ENAME (type sel))
(if (and pred (not (pred sel)))
(princ "\nInvalid Object Selected.")
)
)
)
)
)
sel
)
(eval pred)
)
)
(if
(and
(setq bl
(_SelectIf "\nSelect Block to Array: "
(function
(lambda ( x )
(and (eq "INSERT" (cdr (assoc 0 (entget x))))
(zerop
(logand 4
(cdr
(assoc 70
(tblsearch "BLOCK" (cdr (assoc 2 (entget x))))
)
)
)
)
)
)
)
)
)
(progn (initget 6)
(setq *rows*
(cond
(
(getint
(strcat "\nSpecify Number of Rows <"
(itoa
(setq *rows* (cond ( *rows* ) ( 10 )))
)
">: "
)
)
)
( *rows* )
)
)
)
(progn (initget 6)
(setq *cols*
(cond
(
(getint
(strcat "\nSpecify Number of Columns <"
(itoa
(setq *cols* (cond ( *cols* ) ( 10 )))
)
">: "
)
)
)
( *cols* )
)
)
)
(progn (initget "Yes No")
(setq *grid*
(cond
(
(getkword
(strcat "\nConstruct Grid-lines? [Yes/No] <"
(setq *grid* (cond ( *grid* ) ( "Yes" )))
">: "
)
)
)
( *grid* )
)
)
)
(setq p1 (getpoint "\nSpecify First Corner of Array: "))
(setq p2
(
(if (zerop (getvar 'WORLDUCS))
getpoint
getcorner
)
"\nSpecify Opposite Corner of Array: " p1
)
)
)
(progn
(setq p0 (vlax-3D-point (trans (cdr (assoc 10 (entget bl))) bl 0))
bl (vlax-ename->vla-object bl)
hd (- (car p2) (car p1))
vd (- (cadr p2) (cadr p1))
xd (/ hd *cols*)
yd (/ vd *rows*)
x1 (- (car p1) (/ xd 2.0))
p3 (list x1 (- (cadr p1) (/ yd 2.0)) (caddr p1))
p4 (polar P1 (angle P1 P2) (/ (distance P1 P2) 2.0)))
)
(_StartUndo
(setq acdoc
(vla-get-activedocument (vlax-get-acad-object))
)
)
(repeat *rows*
(setq p3 (list x1 (+ (cadr p3) yd) (caddr p3)))
(repeat *cols*
(vla-move (vla-copy bl) p0
(vlax-3D-point
(trans (setq p3 (list (+ (car p3) xd) (cadr p3) (caddr p3))) 1 0)
)
)
)
)
(if (eq "Yes" *grid*)
(progn
(setq p3 (list (car p1) (- (cadr p1) (/ yd 2.0)) (caddr p1)))
(repeat *rows*
(setq p3 (list (car p3) (+ (cadr p3) yd) (caddr p3)))
(entmakex
(list
(cons 0 "LINE")
(cons 8 layer)
(cons 10 (trans p3 1 0))
(cons 11 (trans (list (+ (car p3) hd) (cadr p3) (caddr p3)) 1 0))
)
)
)
(setq p3 (list (- (car p1) (/ xd 2.0)) (cadr p1) (caddr p1)))
(repeat *cols*
(setq p3 (list (+ (car p3) xd) (cadr p3) (caddr p3)))
(entmakex
(list
(cons 0 "LINE")
(cons 8 layer)
(cons 10 (trans p3 1 0))
(cons 11 (trans (list (car p3) (+ (cadr p3) vd) (caddr p3)) 1 0))
)
)
)
)
)
(command "insert" "light" p4)
(_EndUndo acdoc)
)
)
(princ)
)
;;------------------------------------------------------------;;
(vl-load-com) (princ)
;;------------------------------------------------------------;;
;; End of File ;;
;;------------------------------------------------------------;;
I added = p4 (polar P1 (angle P1 P2) (/ (distance P1 P2) 2.0)))
trying to set the center of the room using p1 and p2
I added = (command "insert" "light" p4)
I would think that it would work like this,, eventually I would like the option to ask if you want to add a ceiling light or ,, a fan light.. yes or no
Any input please? Nick
Solved! Go to Solution.
