Reklam

* E Posta Adresiniz:
* Kodu Girin:

Merdiven çizen lisp

kocmuhendislik@yahoo.com
otokoc - 25.06.2005 12:31
Yazar: internet
İçerik:

(Kontrol panelinizde görünür)


Aşağıdaki pencereden AutoLISP kodlarını Ctrl + C ile kopyalayabilirsiniz

Kod:

(defun str_err (msg)

(if (/= msg nil)
(progn
(princ (strcat "nError: " msg )) (princ)
(str_normex)
(str_varnil)
) ;progn
) ;if
) ;defun

;;;----------------------------------------------------------------------------;;;

;-> resets ACAD variables (normal exit)

(defun str_normex ()

(setvar "lunits" slun)
(setvar "luprec" slprec)
(setvar "osmode" sosm)
(setvar "plinewid" splw)
(setvar "cmdecho" scmd)
(setvar "textsize" stxtsz)
(setq *error* old_error)
(setq old_error nil)

) ;defun

;;;---------------------------------------------------------------------------;;;

;-> set all stairs.lsp variables to nil

(defun str_varnil ()

(foreach varlst '(ff th apx dvsr tavg mintrd midtrd maxtrd
nzh nzl slun slprec sosm splw nor lft rt dn
rht trdflt tsiz tdir nostp step nostp rnded
dflts pt1 pt2 pt3 pt4 pt5 strshp scmd ang
dist horiz botris stxtsz txtpt prntxt)
(set varlst nil)
) ;foreach
(princ)
) ;defun

;;;---------------------------------------------------------------------------;;;

;-> define math functions

(defun dtr (a)
(* pi (/ a 180.0))
)

(defun tan (a)
(/ (sin a) (cos a))
)

(defun rnd (n / fn sfn)
(setq fn (fix n))
(setq sfn (- n fn))
(if (>= sfn 0.5)
(setq n (+ fn 1))
(setq n fn)
) ;if
) ; defun

;;;---------------------------------------------------------------------------;;;


(defun str_setup ()

;-> set variables

(str_varnil) ;-> set stairs.lsp variables to nil
(setq old_error *error* ;-> trap old error handler
*error* str_err) ;-> set error handler
(setq slun (getvar "lunits"))
(setvar "lunits" 2 ;-> decimal
)
(setq slprec (getvar "luprec"))
(setvar "luprec" 4 ;-> four decimal places
)
(setq splw (getvar "plinewid"))
(setvar "plinewid" 0.0 ;-> set polyline width
)
(setq sosm (getvar "osmode")
)
(setq scmd (getvar "cmdecho"))
(setvar "cmdecho" 0 ;-> set cmdecho off
)
(setq stxtsz (getvar "textsize"))
(setvar "textsize" 6 ;-> set textsize to 6
)

) ;defun

;;;---------------------------------------------------------------------------;;;

;-> call other info functions

(defun str_info ()

(str_ht) ;1
(str_dir) ;2
(str_shp) ;3
(str_default) ;4
(str_ris_ht) ;5
(str_trd_siz) ;6
(str_trd_th) ;7
(str_nozlen) ;8

);defun

;;;---------------------------------------------------------------------

;->determine total height #1 from info

(defun str_ht ( / ff) ;-> first floor

(princ "nDetermine Overall Height...")
(setvar "osmode" 512) ;-> set osnap to nearest
(initget 9)
(setq ff (getpoint "nPick Any Point On The Lower Level: "))
(setvar "osmode" 33)
(initget 9)
(setq pt1 (getpoint "nPick The Top Step: "))
(setq th (-(cadr pt1)(cadr ff)))
(setq txtpt (polar pt1 (/ pi 2.0) 36))

);defun

;;;-------------------------------------------------------------------------

;->determine stair direction #2 from info

(defun str_dir ()

(princ "nDetermine Stair Direction...")
(initget 1 "Left Right")
(setq tdir (getkword "nStairs Go Down To Right or Left? (R or L) "))
(if (= (substr tdir 1 1) "R")
(setq tdir nil)
(setq tdir 1)
) ;if
) ;defun

;;;---------------------------------------------------------------------

;->determine stair shape #3 from info

(defun str_shp ()

(princ "nDetermine Nosing Shape...")
(initget 7 "Square Round")
(setq strshp (getkword "nDo You Want Square Or Round Nose? (S or R) "))
(if (= (substr strshp 1 1) "S")
(setq strshp nil)
(setq strshp 1)
) ;if
) ;defun

;;;-------------------------------------------------------------------------;;;

;->accept defaults or customize #4 from info

(defun str_default ()

(princ "nSelect Design Method...")
(initget 6 "Customize Defaults")
(setq dflts (getkword "nCustomize or Defaults (C or D) <Defaults>"))
(if (or
(= dflts nil)
(= (substr dflts 1 1) "D")
) ;or
(setq dflts 1)
(setq dflts nil)
) ;if
) ;defun

;;;-------------------------------------------------------------------------;;;

;->determine riser height #5 from info

(defun str_ris_ht ( / dvsr ;->desired riser height (divisor)
apx
rnded) ;->rounded apx

(princ "nDetermine Riser Height...")
(if dflts
(progn ;then
(setq nor (rnd (/ th 7)))
(setq rht (/ th nor))
) ;progn then
(progn ;else
(initget 6)
(setq dvsr (getreal (strcat
"nDesired Riser Height Is: <7"> " )))
(if (= dvsr nil) (setq dvsr 7)
) ;if
(setq apx(/ th dvsr))
(princ (strcat
"nTotal Height Divided By " (rtos dvsr 4 4) " is: " (rtos apx))
) ;princ
(setq rnded (rnd apx))
(initget 6)
(setq nor (getint (strcat
"nHow Many Risers Do You Want?: <"(itoa rnded)"> ")))
(if (= nor nil) (setq nor rnded)
) ;if
(setq rht (/ th nor))
(princ (strcat "nRiser Height Is: " (rtos rht 5 5) """))
) ;progn else
) ;if
) ;defun

;;;------------------------------------------------------------------------

;->determine tread size #6 from info

(defun str_trd_siz ( / horiz ;-> horizontal constraints y or n
botris ;-> point for bottom riser
tavg ;-> average of first three tests
mintrd ;-> tread size @ 35 degrees
midtrd ;-> " " @ 32.5 "
maxtrd ;-> " " @ 30 "
trdflt) ;-> default tread size

;->if constrained horizontally, set tread size to fit

(princ "nDetermine Tread And Nosing Size...")
(if (not dflts) ;customize
(progn ;then
(initget 6 "Yes No")
(setq horiz (getkword
"nHorizontal Constraints? (Y or N): <N>"))
(if (or
(= horiz nil)
(= (substr horiz 1 1) "N")
) ;or
(setq horiz nil)
(setq horiz 1)
) ;if
) ;progn then
) ;if not dflts

(if horiz
(progn ;then
(setvar "osmode" 33)
(initget 9)
(setq botris (getpoint "nPick Point For Bottom Riser:"))
(setq tsiz (abs (/ (- (car pt1) (car botris)) (- nor 1))))
) ;progn then

;->first three rules of stairs average

(progn ;else
(setq tavg (/ (+ (- 17.25 rht) (- 24.5 rht) (/ 72.5 rht)) 3))

;->test for angle of stairs and set tread size default

(setq mintrd (/ rht (tan (dtr 35))))
(setq midtrd (/ rht (tan (dtr 32.5))))
(setq maxtrd (/ rht (tan (dtr 30))))
(if (and
(>= tavg mintrd)
(<= tavg maxtrd)
) ;and
(setq trdflt tavg)
(setq trdflt midtrd)
) ;if
(if dflts
(setq tsiz trdflt) ;then
(progn ;else

;->display range of tread sizes for 30-35 degree stair

(princ "nFor Stair Between 30 and 35 Degrees...")
(princ (strcat
"nTread Should Be: " (rtos mintrd 5 4) "" to " (rtos maxtrd 5 4) """)
) ;princ
(initget 6)
(setq tsiz (getreal (strcat
"nEnter Tread Size In Inches: <" (rtos trdflt 5 4) "">")))
(if (= tsiz nil) (setq tsiz trdflt)
) ;if
) ;progn else
) ;if dflts
) ;progn
) ;if horiz

;->display angle of stairs

(princ (strcat
"nAngle Of Stairs Is: " (angtos (atan rht tsiz) 0 2) " Degrees")
) ;princ

) ;defun

;;;---------------------------------------------------------------------------;;;

;->determine tread thickness #7 from info

(defun str_trd_th ()

(if (and
(= dflts 1)
(not strshp)
) ;and
(setq nzh 1.5)
) ;if

(if (and
(not dflts)
(not strshp)
) ;and
(progn ;then
(initget 4)
(setq nzh (getreal (strcat
"nEnter Tread Thickness In Inches: <1 1/2"> ")))
(if (= nzh nil) (setq nzh 1.5))
) ;progn then
) ;if

(if (and
(= dflts 1)
(= strshp 1)
) ;and
(setq nzh 1.25)
) ;if

(if (and
(not dflts)
(= strshp 1)
) ;and
(progn ;then
(initget 6)
(setq nzh (getreal (strcat
"nEnter Tread Thickness In Inches: <1 1/4"> ")))
(if (= nzh nil) (setq nzh 1.25))
) ;progn then
) ;if
) ;defun

;;;--------------------------------------------------------------------------

;->determine nosing overhang #8 from info

(defun str_nozlen ()

(if dflts
(setq nzl 1.25) ;then
(progn ;else
(if (and
(not dflts)
(not strshp)
) ;and
(initget 4)
) ;if
(if (and
(not dflts)
(= strshp 1)
) ;and
(initget 6)
) ;if
(setq nzl (getreal (strcat
"nEnter Nosing Overhang In Inches: <1 1/4"> ")))
(if (= nzl nil) (setq nzl 1.25)
) ;if
) ;progn else
) ;if dflts
) ;defun

;;;--------------------------------------------------------------------------

;-> draw steps

(defun str_draw ( / pt2 ;->points for polylines
pt3 ;-> " " "
pt4 ;-> " " "
pt5 ;-> " " "
lft ;-> left for polar
rt ;-> right "
dn ;-> dn "
ang ;-> angle "
dist ;-> distance "
nostp ;-> counter for while loop
step) ;-> entity to copy

(if (not tdir)
(progn ;then
(setq rt 0.0)
(setq lft pi)
) ;progn
(progn ;else
(setq rt pi)
(setq lft 0.0)
) ;progn
) ;if
(setq dn (* pi 1.5))
(if strshp (setq nzl (- nzl (* nzh 0.5))) ;->subtract radius
) ;if ; from nosing
(setvar "osmode" 0) ;-> set osnap to none
(setq pt2 (polar pt1 rt nzl))
(setq pt3 (polar pt2 dn nzh))
(setq pt4 (polar pt3 lft nzl))
(if (not strshp)
(command "pline" pt1 pt2 pt3 pt4 "")
(command "pline" pt1 pt2 "a" pt3 "l" pt4 "")
) ;if
(setq pt1 (polar pt1 dn rht))
(setq pt2 (polar pt1 rt (+ tsiz nzl)))
(setq pt3 (polar pt2 dn nzh))
(setq pt4 (polar pt3 lft nzl))
(setq pt5 (polar pt4 dn (- rht nzh)))
(if (not strshp)
(command "pline" pt1 pt2 pt3 pt4 pt5 "")
(command "pline" pt1 pt2 "a" pt3 "l" pt4 pt5 "")
) ;if
(setq ang (angle pt1 pt5))
(setq dist (distance pt1 pt5))
(setq nostp (- nor 2)) ;-> set counter for while loop
(while (>= nostp 1)
(setq step (entlast))
(setq pt1 pt5)
(setq pt5 (polar pt1 ang dist))
(command "copy" step "" pt1 pt5)
(setq nostp (1- nostp))
) ;while
) ;defun

;;;---------------------------------------------------------------------------;;;

;->display properties of stairs at command line and prompt if you
;->want to print that information on the drawing.

(defun str_display ( / prntxt)

(initget "Yes No")
(setq prntxt (getkword
"nPrint Stair Dimensions On Drawing? (Y or N) <Y>"))
(if (or
(= prntxt nil)
(= prntxt "Yes")
) ;or
(setq prntxt 1)
) ;if

(if (= prntxt 1)
(progn
(if (= (cdr (assoc 40 (tblsearch "style" ;if no fixed
(getvar "textstyle")))) 0.0) ;text height
(command "text" txtpt "" "" ;then
(strcat "Overall Height Is: " (rtos th 4 4)))
(command "text" txtpt "" ;else
(strcat "Overall Height Is: " (rtos th 4 4)))
) ;if
(command "text" ""
(strcat (itoa nor)" Risers @ "(rtos rht 5 5)"""))
(command "text" ""
(strcat (itoa (- nor 1))" Treads @ "(rtos tsiz 5 4)"""))
(command "text" ""
(strcat "Angle is: " (angtos (atan rht tsiz) 0 2)" Degrees"))
) ;progn
) ;if

(princ (strcat
"nOverall Height Is: "(rtos th 4 4)))
(princ (strcat
"n"(itoa nor) " Risers @ "(rtos rht 5 5)"" " ))
(princ (strcat
(itoa (- nor 1)) " Treads @ "(rtos tsiz 5 4)"" "))
(princ (strcat
"Angle is "(angtos (atan rht tsiz) 0 2) " Degrees"))

) ;defun

;;;---------------------------------------------------------------------------;;;

;-> defines ACAD command "stairs"

(defun c:stairs ( / slun ;-> trap lunits
slprec ;-> trap lunits precision
sosm ;-> trap osnap setting
splw ;-> trap plinewidth
scmd ;-> trap cmdecho
stxtsz ;-> trap textsize
nor ;-> number of risers
rht ;-> riser height
tsiz ;-> tread size
nostp ;-> number of steps
strshp ;-> stair shape (round or square nose)
th ;-> total height
pt1 ;-> top step
txtpt ;-> point for text on drawing
tdir ;-> stair direction
dflts ;-> defaults or customize flag
nzh ;-> nosing height (tread thickness)
nzl) ;-> nosing overhang length

(prompt "nStairs.lsp by DETOUR (C) Copyright By Dan E. Thomas 1997")
(str_setup)
(str_info)
(str_draw)
(str_display)
(str_normex)
(princ)

) ;defun
(PRINC "--> 'www.cizimokulu.com' Çizim yardımları yüklendi !")


Bu kodları nasıl kullanacağınızı bilmiyorsanız aşağıdaki linkten;
AutoLISP > Konu Anlatımları > Lisp Dosyalarının oluşturulması ve Yüklenmesi
konusunu inceleyiniz.


Bu lispin sorunsuz çalışan halini download bölümünden indirebilirsiniz.
Merdiven Çizen Lisp (Stair.lsp)
Yorumlar :
admin   15.08.2017 15:34 #15800  

Lisplerde komut "defun c:" tanımlamasının devamındaki ifadedir. Dolayısıyla burada defun c:stairs ifadesindeki stairs komuttur.

orxan89   25.02.2016 09:00 #15639  

Arkadashlar merhaba bu lispin komutu ne ?

umlin1203   30.09.2010 11:27 #13313  

Ellerinize sağlık çok teşekkür ederiz

nzka   18.04.2009 15:22 #10953  

emeğine sağlık

poissonn   23.02.2009 16:06 #10548  

ben 2007 verssiyonuyla denedim calıstı

Norfuesjack   28.11.2007 22:16 #6562  

Bu acaba alıntımı yapılmıs bir yerden yoksa gercekten ayrı bir programda felan mı kullanılıyor anlamadım ben bisi

dduummaann   27.08.2007 16:32 #5261  

KOMUT DOGRUMU ?STAİR

RasqutiN   28.02.2007 11:58 #2959  

Böyle bir lisp'e gerek yok bence,değer girene kadar 50 adet kopyalama yapabilirim.

teknikerdem   15.01.2007 16:56 #1838  

admin   12.12.2006 22:29 #1294  

Bu lispin sorunsuz çalışan halini download bölümünden indirebilirsiniz.
Merdiven Çizen Lisp (Stair.lsp)

kalpsiz   12.12.2006 16:03 #1290  

Ben denemedim ama.
command satırına stairs yazdığınızdan eminmisiniz.

c_enay   08.12.2006 23:52 #1232  

ee neden kimsey cevap verilmemiş

rsahin   17.11.2006 02:36 #959  

yaf çalıştırabilen bi Allahın kulu yokmu bunu )

redrua   16.11.2006 13:57 #953  

her deneyen çalışmıyor diyorsa bir bildikleri vardır ben de denedim çalıştıramadım

oo   31.10.2006 21:10 #796  

evet calışmıyor ..neden eksik

ibutun   07.07.2006 12:02 #398  

bende çalıştıramadım hatta hiç bir örnek olmuyor yoksa ben mi yanlış yapıyorum

hkndrsn   30.06.2006 13:58 #385  

çalışmıyor nasıl çalıştığını da yazın

DONJUANTURK   03.03.2006 23:32 #243  

çalışmıyo bu yavvvvvvv

Copyright © 2004-2018 | Tüm Hakları Saklıdır | 1365 | Site haritası | İstatistikler | Hakkımızda | Kadromuz | Gizlilik | Reklam