This is a poor example of a lisp routine.
I modified it to work if you only select a line object. That too needs to be fixed.
But I have no more time tonight.
Code:
;;; CADALYST 07/08 www.cadalyst.com/code
;;; Tip 2295: ShelfRod.lsp Draw Closet Detail (c) 2008 Mike Carter
;; This routine offsets a given wall line by 12" and by 10" and changes
;; new lines to the F?CAB and F?DASH layers. Used for drawing shalves
;; and rods in closets.
(DEFUN C:SHELFROD (/ ANG1 COUNTER FIRSTENDPNT HANGERDIST PAUSE PNT2 PNT3 PNT4
PREFIX RODLENGTH ROTATE SECONDENDPNT TCLAYER TORTHOMODE
TOSMODE WALLLINE *error*
)
(defun *error* (msg)
(setvar "OSMODE" TOSMODE)
(setvar "ORTHOMODE" TORTHOMODE)
(setvar "CLAYER" TCLAYER)
(prompt msg)
(princ)
) ;end defun
(defun LayerMake(lyrname Color ltype)
(if (tblsearch "LAYER" lyrname)
(command "._Layer" "_Thaw" lyrname "_On" lyrname "_UnLock" lyrname "_Set" lyrname "")
(command "._Layer" "_Make" lyrname "_Color"
(if (or (null color)(= Color "")) "_White" Color) lyrname
"LT" (if (or (null ltype)(= ltype "")) "Continuous" ltype) lyrname "")
)
)
(graphscr)
(setvar "CMDECHO" 0)
(setq
TOSMODE (getvar "OSMODE")
TORTHOMODE (getvar "ORTHOMODE")
TCLAYER (getvar "CLAYER")
)
(setvar "OSMODE" 512) ; nearest
; CAB added
(or Prefix (setq Prefix "F1"))
(LayerMake "F1CAB" "white" nil)
(LayerMake "F1Dash" "white" "Dashed")
(LayerMake "F1Furn" "green" nil)
(LayerMake "F1Text" "Yellow" nil)
(setq
wallline (entsel "\nPick STUD WALL LINE to offset: ") ; CAB must be a line !!
firstendpnt (trans (cdr (assoc 10 (entget (car wallline)))) 0 1)
secondendpnt (trans (cdr (assoc 11 (entget (car wallline)))) 0 1)
pnt2 (getpoint "\nSpecify point toward closet: ")
ang1 (angle firstendpnt secondendpnt)
) ;end setq
(if (and (> ang1 (/ pi 2.0)) (<= ang1 (* pi 1.5)))
(setq ang1 (+ ang1 pi))
) ;end if
(setvar "OSMODE" 0) ; none
(command "offset" 12 wallline pnt2 "")
(command "change" "L" "" "P" "LA" (STRCAT PREFIX "CAB") "")
(command "offset" 10 wallline pnt2 "")
(command "change" "L" "" "P" "LA" (STRCAT PREFIX "DASH") "") ;end command
(setvar "OSMODE" 512) ; nearest
(setq
pnt3 (getpoint "\nPick START OF HANGERS on dashed ROD LINE: ")
pnt4 (getpoint "\nPick END OF HANGERS on dashed ROD LINE: ")
rodlength (distance pnt3 pnt4)
hangerdist 1.0
) ;end setq
(command "erase" "L" "" "erase" "L" "")
(setvar "OSMODE" 0) ; none
(while (>= (- rodlength hangerdist) 0)
(setq
rotate (rtos (getvar "DATE") 2 12)
rotate (substr rotate (strlen rotate))
) ;end setq
(if (= rotate "0")
(setq rotate "5")
)
(setq
rotate (atoi rotate)
rotate (/ rotate 5.0)
rotate (- rotate 1)
rotate (* rotate 10)
) ;end setq
(cond
((= rotate -8.0) (setq rotate -4.5))
((= rotate -6.0) (setq rotate 1.5))
((= rotate -4.0) (setq rotate -7.5))
((= rotate -2.0) (setq rotate 5.5))
((= rotate 0.0) (setq rotate 4.0))
((= rotate 2.0) (setq rotate 0.5))
((= rotate 4.0) (setq rotate -6.0))
((= rotate 6.0) (setq rotate -2.5))
((= rotate 8.0) (setq rotate 8.0))
) ;end cond
(command "-layer" "T" (strcat prefix "FURN") "M" (strcat prefix "FURN") "")
(command "line" "fro" pnt3
(strcat "@9<" (angtos (+ ang1 (* (/ 90.0 180.0) pi))))
(strcat "@18<" (angtos (- ang1 (* (/ 90.0 180.0) pi))))
"")
(command "rotate" "L" "" pnt3 rotate)
(command "move" "P" "" "0,0"
(strcat "@" (rtos hangerdist) "<" (angtos (angle pnt3 pnt4)))
) ;end command
;|( (setq counter 1) ; CAB removed delay
while (< counter 12000)
(setq counter (+ counter 1))
) ;end while |;
(setq hangerdist (+ hangerdist (+ 2 (/ rotate 8.0))))
) ;end while
(command "offset" 12 wallline pnt2 "")
(command "change" "L" "" "P" "LA" (STRCAT PREFIX "CAB") "")
(command "offset" 10 wallline pnt2 "")
(command "change" "L" "" "P" "LA" (STRCAT PREFIX "DASH") "")
(prompt "\nPosition text: ")
(setvar "ORTHOMODE" 0)
;; CAB changed
;; If text height is undefined (signified by 0 in the table)
(if (zerop (cdr(assoc 40(tblsearch "style" (getvar "textstyle")))))
;; Draw the text using the current text height (textsize)
(command ".text" "c" "_non" (getvar "LASTPOINT") ""(angtos ang1) "1R & 1S")
;; Otherwise use the defined text height
(command ".text" "c" "_non" (getvar "LASTPOINT") (angtos ang1) "1R & 1S")
) ; endif
;; (command "text" "C" (getvar "LASTPOINT") (angtos ang1) "1R & 1S")
(command "change" "L" "" "P" "LA" (STRCAT PREFIX "TEXT") "")
(command "move" "L" "" (getvar "LASTPOINT") pause)
(setvar "OSMODE" TOSMODE)
(setvar "ORTHOMODE" TORTHOMODE)
(setvar "CLAYER" TCLAYER)
(princ)
) ;end defun
Closet Rod & Shelf LSP Not Working
Reply With Quote
