09.07.2008 10:07    

Harbi65
Gösterilen yaydan gösterilen çizgiye istenilen sayıda izdüşüm çizer.
Çalıştırmak için YAYC

Kod:

(defun YAY_hata (s)
  (if (/= s "Function cancelled")
    (princ (strcat "\nError: " s))
  )
  (setvar "cmdecho" YAY_cmd)
  (setvar "PICKBOX" YAY_pxb)
  (setvar "OSMODE" YAY_osm)
  (if cizgi
    (redraw (car yay_sec) 4)
  )
  (setq *error* olderr)
  (princ)
)
;;;                                                              ;;;
(defun c:YAYC (/)
  (setq olderr *error*
*error* YAY_hata
  )
  (setvar "modemacro" "< Harbi65 Design 2008 © by >")
  (setq YAY_cmd (getvar "cmdecho")
YAY_osm (getvar "OSMODE")
YAY_pxb (getvar "PICKBOX")
  )
  (setvar "cmdecho" 0)
  (setvar "PICKBOX" 6)
  (command "._UNDO" "_BEGIN")
  (initget 1 "T Y")
  (setq BOL_MES (getkword "\n* Tam mı bölünecek? Yarım mı..? [T / Y]:"))

  (setq yay_n nil)
  (while (= yay_n nil)
    (setq yay_sec (entsel "\n İzdüşümü alınacak Yayı Seç:"))
    (if (= yay_sec nil)
      (progn
(if (= (getvar "errno") 7)
  (progn (setq yay_n nil)
(setvar "errno" 0)
  )
)
(if (= (getvar "errno") 52)
  (progn (setq yay_n t)
(setvar "errno" 0)
  )
)
(if (= (getvar "errno") 87)
  (progn (setq yay_n t)
(setvar "errno" 0)
  )
)
      )
      (progn
(setq elist (entget (car yay_sec))
      aarc  (cdr (assoc 0 elist))
)
(if (/= aarc "ARC")
  (progn
    (print "*** Lütfen ARC seçiniz ***")
    (setq yay_sec nil)
  )
  (progn
    (setq duv_kln 15.0)
    (redraw (car yay_sec) 3)

    (setq czg_n nil)
    (while (= czg_n nil)
      (setq czg_sec (entsel "\n İzdüşüm gidecek Çizgiyi seç:"))
      (if (= czg_sec nil)
(progn
  (if (= (getvar "errno") 7)
    (progn (setq czg_n nil)
   (setvar "errno" 0)
    )
  )
  (if (= (getvar "errno") 52)
    (progn (setq czg_n t)
   (setvar "errno" 0)
    )
  )
  (if (= (getvar "errno") 87)
    (progn (setq czg_n t)
   (setvar "errno" 0)
    )
  )
  (print "* Çizgi seçilmedi *")
)
(progn
  (setq a_czg (entget (car czg_sec))
lline (cdr (assoc 0 a_czg))
  )
  (if (/= lline "LINE")
    (progn
      (print "*** Seçilen nesne LINE değil ***")
      (setq czg_sec nil)
    )
    (progn
      (setq merk   (cdr (assoc 10 elist))
    ycap   (cdr (assoc 40 elist))
    bas_aci   (cdr (assoc 50 elist))
    son_aci   (cdr (assoc 51 elist))
    czg10  (cdr (assoc 10 a_czg))
    czg11  (cdr (assoc 11 a_czg))
    czg10b (cdr (assoc 10 a_czg))
    czg11b (cdr (assoc 11 a_czg))
      )
      (setq cgz_ang  (angle czg10 czg11)
    merk_ang (angle czg10 merk)
      )
      (setq cgz_boy (distance czg10 czg11))
      (setq fark (- son_aci bas_aci)
    i 0
      )
      (if (< fark 0.0)
(setq fark (+ (* 2 PI) fark))
      )
      (setq adt (getint "\n Yay kaça bölünecek? :"))
      (if (= BOL_MES "Y")
(setq adt (* adt 2))
      )
      (setq delta (abs (* (/ fark adt) 1.0)))
      (setvar "osmode" 0)
      (if (= BOL_MES "Y")
(setq adt (/ adt 2))
      )
      (repeat adt
(setq n1 (polar merk (+ (* i delta) bas_aci) ycap)
      n2 (polar merk
(+ (* (+ 1 i) delta) bas_aci)
ycap
)
)
(setq ang_N1 (angle n1 czg10))
(setq mes_N1 (distance czg10 n1))
(setq angrad (- cgz_ang ang_N1))
(if (< cgz_ang ang_N1)
  (setq angrad (- ang_N1 cgz_ang))
)
(setq dar_aci (- angrad (/ pi 2.0)))
(setq Hiz_kisa1 (* mes_N1 (sin dar_aci)))
(setq cgz_X1 (polar czg10 cgz_ang Hiz_kisa1))
(command "LINE" n1 cgz_X1 "")

(if (= i 0)
  (setq nn1 adt1)
)
(setq i (1+ i))
      )
      (setq ang_N2 (angle n2 czg10))
      (setq mes_N2 (distance czg10 n2))
      (setq angrad (- cgz_ang ang_N2))
      (if (< cgz_ang ang_N2)
(setq angrad (- ang_N2 cgz_ang))
      )
      (setq dar_aci (- angrad (/ pi 2.0)))
      (setq Hiz_kisa2 (* mes_N2 (sin dar_aci)))
      (setq cgz_X1a (polar czg10 cgz_ang Hiz_kisa2))
      (command "LINE" n2 cgz_X1a "")
      (redraw (car yay_sec) 4)
      (setq czg_n t)
    )
  )
)
      )
    )
  )
)
      )
    )
  )
  (command "._UNDO" "_END")
  (setvar "cmdecho" YAY_cmd)
  (setvar "PICKBOX" YAY_pxb)
  (setvar "OSMODE" YAY_osm)
  (princ)
)
(princ
  "\n Gösterilen yaydan gösterilen çizgiye istenilen sayıda izdüşüm çizer [ YAYC ]"
)

09.07.2008 10:25    

srduncu
vay beee lispinde böylesi:)))emeğine sağlık kardeş kolay gelsin.....

> 1 <
Copyright © 2004-2022 SQL: 1.386 saniye - Sorgu: 44 - Ortalama: 0.03149 saniye