Reklam

* E Posta Adresiniz:
* Kodu Girin:

İleti Yazar
19.11.2016 14:30
84211    
heisenberg33

[2] Girişimci

Online Durumu

4 ileti
Topoğraf
mersin

Hocam sectigimiz line,polyline,point'in Z degerini verecek lispe cok ihtiyac duyuyorum. Eger varsa paylasabilir misiniz?

09.05.2018 10:43
86307    
folderdash

[2] Girişimci

Online Durumu

1 ileti
harita mühendisi
istanbul

Alıntı
ProhibiT :
Merhaba arkadaşlar.

Bundan 6 yıl önce burada paylaştığım Lisp program. O zamanın şartlarına göre, arkadaşlarımızın istekleri doğrultusunda yazılmıştı. Zaman içinde gelen isteklerin tümünü karşılayacak şekilde yeniden düzenleyip paylaşıyorum.
Kod:

;|---------------------------------------------------------------------------|
| Bu Program M.Ş. Güvercin tarafından                                       |
| Mehmet Yangın için Hazırlanmıştır. 08.12.2009 22:10                       |
| Bu konu başlığı altında gelen isteklere göre Düzenlendi...                |
|           ProhibiT www.cizimokulu.com 28.08.2015  14:15                   |
|---------------------------------------------------------------------------|;
(defun c:KoMe (/ dgrl eksen kot kotor msf mesor n1 n2 n3 n4 nokta nokx noky
               onbs otsz refko tsz)
  (defun tRL  (dgr ob / frk) (if (not (vl-string-search "." dgr))
      (setq dgr (strcat dgr ".") frk ob)
      (setq frk (- ob (- (strlen dgr) (1+ (vl-string-search "." dgr))))))
    (if (> frk 0) (repeat frk (setq dgr (strcat dgr "0"))) (setq dgr dgr)))
  (command "undo" "group") (setvar "cmdecho" 0)
  (if (not tsz) (setq tsz (getvar "textsize"))) (if (not (setq otsz tsz tsz
(getreal (strcat "\nYazı Yüksekliği <" (rtos tsz 2) ">: ")))) (setq tsz otsz))
  (if (not onbs) (setq onbs (getvar "Luprec")))
  (if (not (setq oonb onbs onbs (getint
(strcat "\nOndalik Basamak Sayısı <" (itoa onbs) ">: ")))) (setq onbs oonb))
  (while (/= "LINE" (cdr (assoc 0 (entget
                (setq eksen (car (entsel "\nEksen Çizgisini Seçiniz..."))))))))
  (setq mesor (cadr (assoc 10 (entget eksen)))
        kotor (cadr (getpoint "\nReferans Kot Noktasını Seçiniz..."))
        refko (getreal "\nReferans Kot Değerini Giriniz: "))
  (while (setq nokta (getpoint "\Yeni Nokta Seçiniz..."))
    (setq nokx (car nokta) noky (cadr nokta) msf (rtos (- nokx mesor) 2 onbs)
          kot  (rtos (+ refko (- noky kotor)) 2 onbs)
          dgrl (getpoint nokta "\nYazıların yerini seçiniz..."))
    (setq msf (tRL msf onbs) kot  (tRL kot onbs))
    (if (zerop (atof kot)) (setq kot (strcat "%%p" kot))
      (if (> (atof kot) 0) (setq kot (strcat "+" kot))))
      (if (> (atof msf) 0) (setq msf (strcat "+" msf)))
    (if (> (cadr dgrl) noky)
      (setq n1 (polar nokta (* pi 0.25) (* tsz 0.707106781))
            n2 (polar nokta (* pi 0.75) (* tsz 0.707106781))
            n3 (polar nokta (* pi 0.50) (* tsz 1.00))
            n4 (polar nokta (* pi 0.50) (* tsz 2.50)))
      (setq n1 (polar nokta (* pi 1.25) (* tsz 0.707106781))
            n2 (polar nokta (* pi 1.75) (* tsz 0.707106781))
            n3 (polar nokta (* pi 1.50) (* tsz 2.00))
            n4 (polar nokta (* pi 1.50) (* tsz 2.50))))
    (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(67 . 0)
      '(100 . "AcDbPolyline") '(90 . 3) '(70 . 1) '(62 . 1) (cons 10 nokta)
       (cons 10 n1) (cons 10 n2)))
    (entmake (list (cons 0 "TEXT") (cons 10 n3) (cons 1 kot) (cons 40 tsz)
       (cons 72 1) (cons 73 0) (cons 50 0) (cons 73 0) (cons 11 n3)))
    (if (> (cadr dgrl) noky)
      (entmake (list (cons 0 "TEXT") (cons 10 n4) (cons 1 msf) (cons 40 tsz)
        (cons 62 1) (cons 50 (/ pi 2.0)) (cons 72 0) (cons 73 2) (cons 11 n4)))
      (entmake (list (cons 0 "TEXT") (cons 10 n4) (cons 1 msf) (cons 40 tsz)
      (cons 62 1) (cons 50 (/ pi 2.0)) (cons 72 2) (cons 73 2) (cons 11 n4)))))
  (command "undo" "e") (prin1))

Herkese kolay gelsin.



Hocam selamlar

Öncelikle emeğinize sağlık.Sorum şu enkesitlerde düşey ölçek normalden 5 kat küçük.

Yani yatayda gerçekte 1 birim olan çizgi 1 birim çizilirken, düşeyde ise gerçekte 1 birim olan çizgi 5 birim olarak çiziliyor. Yazdığınız bu lispi bu yönde nasıl düzenleyebiliriz?

Teşekkürler

Teşekkürler

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