28.05.2013 11:22    

CAN123
Merhaba,
Civata boylarını hesaplayacak bir lispe ihtiyacım var. Lispin işleyişi şöyle olacak; öncelikle gireceğim malzeme kalınlıklarını toplayıp çıkan sonuca denk gelen civatayı çizime yazdıracak bir lisp. Daha acık yazmak gerekirse mesela kalınlıkları 5, 4, 7 olan 3 malzemenin toplam kalınlığı 16mm. Bu 16mm kalınlıga denk gelen civata M16x45 ve bu civatayı çizime 1M16x45 olarak yazdıracak bir lisp. Kalınlık değerlerini aşagıdaki listeden alacak.

6-10 M16x35
11-15 M16x40
16-20 M16x45
21-25 M16x50


teşekkurler

28.05.2013 21:05    

Travaci
Kod:

(defun c:cVthSp (/ tHt oNe tWo tRe tPL wRt pNt)
   (initget 7) (setq oNe (geTint "\n1. Deger: "))
   (initget 7) (setq tWo (geTint "\n 2. Deger: "))
   (initget 7) (setq tRe (geTint "\n  3. Deger: "))
   (setq tPL (+ oNe tWo tRe) tHt (geTvar "TextSize"))
   (cond
      ((or (< tPl 6) (> tPl 45))
      (progn (alert "\nBu boyutlara uygun civata yok !
                     \nProgramı tekrar çalıştırın."))
                                              (exit))
      ((and (<= 6 tPL) (>= 10 tPL)) (setq wRt "1M16x35"))
      ((and (<= 11 tPL) (>= 15 tPL)) (setq wRt "1M16x40"))
      ((and (<= 16 tPL) (>= 20 tPL)) (setq wRt "1M16x45"))
      ((and (<= 21 tPL) (>= 45 tPL)) (setq wRt "1M16x50")))
   (setq pNt (getpoint "\nYazılcak nokta: " ))
   (if (= pNt nil)
       (progn (princ "\nProgram sonlandırıldı !"))
       (enTmake (list (cons 0 "Text") (cons 10 pNt) (cons 11 pNt)
       (cons 1 wRt) (cons 40 tHt) (cons 72 1) (cons 73 1)))) (princ))

29.05.2013 05:19    

CAN123
Cevabınız için çok teşekkur ederim.

Burada girilecek değer her zaman 3 olmuyor. 3'ten az yada çok olabiliyor.Mesela girilecek değerler bittikten sonra entera bastıktan sonra yazıyı yazdırabilirmiyiz.

teşekkurler

CAN123 (29.09.2013 10:27 GMT)

28.11.2013 21:59    

ProhibiT
Kod:

;|===========================================================================|
| bLt: Verilen eleman kalınlıklarına göre bulon boyutu yazar.               |
|      Hazırlayan M.S.Güvercin (ProhibiT) www.cizimokulu.com  28.11.2013    |
|___________________________________________________________________________|;
(defun c:bLt (/ *error* a BuLon Cap ctx dro IDs L sp sp0 Thc tp TTh)
  (setvar "cmdecho" 0) (command "_.undo" "group") (vl-load-com)
  (defun *error* (e) (princ (strcat "\n" e)) (command "_.undo" "end") (princ))
  (defun TrnsLt (pr1 pr2 pr3 /) (vla-transformby (vlax-ename->vla-object pr1)
      (vlax-tmatrix (list (list 1 0 0 (- (car (cadr pr2)) (car pr3)))
                (list 0 1 0 (- (cadr (cadr pr2)) (cadr pr3)))
            (list 0 0 1 (- (caddr (cadr pr2)) (caddr pr3))) (list 0 0 0 1)))))
  (setq Cap (getstring "\n            Bulon Çapı (16): ") L 1 TTh 0)
  (if (= Cap "") (setq Cap "16"))
  (while (setq Thc (getint (strcat "\n" (itoa L) ". Levha Kalınlığı: ")))
    (setq TTh (+ TTh Thc) L (1+ L)))
  (princ (strcat "\nBirleştirilen elaman sayısı: " (itoa (1- L))
                 "\n            Toplam kalınlık: " (itoa TTh)))
  (cond ((and (> TTh 5) (< TTh 11)) (setq Bulon (strcat "1M" Cap "x35")))
        ((and (> TTh 11) (< TTh 16)) (setq Bulon (strcat "1M" Cap "x40")))
        ((and (> TTh 15) (< TTh 21)) (setq Bulon (strcat "1M" Cap "x45")))
        ((and (> TTh 20) (< TTh 46)) (setq Bulon (strcat "1M" Cap "x50")))
        ((progn (princ "\nBu boyutlara uygun civata yok !") (exit))))
  (enTmake (list '(0 . "Text") '(10 0 0 0) '(11 0 0 0) (cons 1 Bulon)
                 (cons 40 (getvar "textsize")) '(50 . 0.0)))
  (defun TrnsLt (pr1 pr2 pr3 /) (vla-transformby (vlax-ename->vla-object pr1)
      (vlax-tmatrix (list (list 1 0 0 (- (car (cadr pr2)) (car pr3)))
                   (list 0 1 0 (- (cadr (cadr pr2)) (cadr pr3)))
            (list 0 0 1 (- (caddr (cadr pr2)) (caddr pr3))) (list 0 0 0 1)))))
  (setq dro (entlast) sp0 '(0.0 0.0 0.0) a nil)
  (while (and (/= 3 (car (setq sp (grread T 4 2)))) (/= (car sp) 25))
    (if a (redraw (ssname a 0) 4)) (TrnsLt dro sp sp0)
    (entdel dro) (setq sp0 (cadr sp))
    (if (setq a (ssget sp0 (list (cons 0 "*text"))))
      (redraw (ssname a 0) 3)) (entdel dro))
  (if (= (car sp) 3) (progn (TrnsLt dro sp sp0) (entdel dro)
      (if (setq tp (ssget sp0 (list (cons 0 "*text"))))
          (setq ctx (entget (ssname tp 0))
                ctx (subst (cons 1 IDs) (assoc 1 ctx) ctx) ctx (entmod ctx)
                ctx (command "updatefield" (cdr (assoc -1 ctx)) ""))
        (entdel dro))) (entdel dro)) (command "undo" "e") (prin1))

29.11.2013 07:19    

CAN123
ProhibiT hocam çok teşekkür ederim, emeğinize sağlık, iyi ki varsınız,

Kolay gelsin.

> 1 <
Copyright © 2004-2022 SQL: 0.917 saniye - Sorgu: 59 - Ortalama: 0.01555 saniye