17.09.2008 09:40    

Bülent_seçkin_akşehir
Arkadaşlar Autocad'te şev taraması yapan lisp varmı forumda aradım ama bulamadım.

yada yapabilecek arkadaşlar yardımcı olursa sevinirim.

Şöyle; şevbaşı ve şevdibini seçtikten sonra tarama sıklığı değişken ( istediğimiz mesafede sıklıkla ) tarama yaptırabilceğim bir lisp. yardımcı olan arkadaşlara şimdiden teşekkürler

02.01.2009 08:19    

s_e_u
Arkadaşlar sahiden yokmu şev taraması için yardım edecek bir bilen?

ehya (02.01.2009 08:36 GMT)

08.01.2009 16:07    

macapapazi
Kod:

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

;; SEV.LSP
;; Maakt een taludarcering tussen bestaande lijnen.
;;
;; ESF
;;

(defun myerror (e)
   (if (/= e "Function cancelled")
   (princ (strcat "\nError:" e))
   )
   (setvar "BLIPMODE" bm)
   (setvar "OSMODE" om)
   (setvar "EDGEMODE" em)
   (setq *error* olderr)
   (setvar "CMDECHO" 1)
   (princ)
)

(defun C:SEV (/ em om bm boven hafst sset1 sset2 cnt even ent ptx pt1 pt2)
   (setq olderr *error* *error* myerror)
   (setvar "CMDECHO" 0)
   (setq om (getvar "OSMODE"))
   (setvar "OSMODE" 0)
   (setq bm (getvar "BLIPMODE"))
   (setvar "BLIPMODE" 0)
   (setq em (getvar "EDGEMODE"))
   (setvar "EDGEMODE" 0)
   (setq cl (getvar "clayer"))

   (command "layer" "make" "Sev-kısa" "color" "7" "Sev-kısa" "")    ;;; toevoeging
   (command "layer" "make" "Sev-uzun" "color" "7" "sev-uzun" "")    ;;; toevoeging

   (if (null (tblsearch "BLOCK" "SEV"))
      (progn
         (command "layer" "set" "0" "")
         (entmake '((0 . "BLOCK") (2 . "SEV") (70 . 64) (10 0.0 0.0 0.0)))
         (entmake '((0 . "LINE") (8 . "Sev-uzun") (10 0.0 0.0 0.0) (11 0.0 0.1 0.0)))   ;;wijziging laagnaam
         (entmake '((0 . "ENDBLK")))
      )
   )
   (setq boven (entsel "\nSev Ustu: "))
   (redraw (car boven) 3)
       (princ "\nSev Altını Sec : ")
       (setq onder (ssget))
    (setq afst 2)
   (if (null afst)
      (setq afst (getdist "\nSev Ara Mesafesi  : "))
      (setq hafst (getdist (strcat "\nSev Ara Mesafesi <"
                (rtos afst 2 2) ">: ")))
   )
   (if hafst (setq afst hafst))
   (redraw (car boven) 4)
   (command "layer" "set" "Sev-uzun" "")
   (command "MEASURE" boven "BLOCK" "SEV" "Y" afst)
   (setq sset1 (ssget "X" '((2 . "SEV"))))
   (setq cnt 0)
   (setq even T)
   (repeat (sslength sset1)
      (setq ent (ssname sset1 cnt))
      (setq ptx (cdr (assoc 10 (entget ent))))
      (command "EXPLODE" ent)
      (command "chprop" "P" "" "layer" "Sev-uzun" "")   ;;;toevoeging
      (setq sset2 (ssget "P")
            ent (ssname sset2 0)
            pt1 (cdr (assoc 10 (entget ent)))
            pt2 (cdr (assoc 11 (entget ent)))
            an (angle pt1 pt2)
            pt1 (list ent (polar pt1 an 0.01))
            pt2 (list ent (polar pt2 (+ an pi) 0.01))
      )
      (command "EXTEND" onder "" pt1 pt2 "")
      (command "TRIM" boven "" pt1 "")
      (if (< (distance (cdr (assoc 10 (entget ent)))
          (cdr (assoc 11 (entget ent)))) 0.01)
          (progn
     (command "ERASE" ent "")
     (setq even nil)
  )
      )
      (if (= even T)
         (progn
    (command "SCALE" ent "" ptx 0.5)
            (command "chprop" ent "" "layer" "Sev-kısa" "")   ;;;toevoeging
    (setq even nil)
)
(setq even T)
      )
      (setq cnt (1+ cnt))
   )
   (setvar "OSMODE" om)
   (setvar "BLIPMODE" bm)
   (setvar "EDGEMODE" em)
   (setq *error* olderr)
   (command "layer" "set" cl "")
   (setvar "CMDECHO" 1)
   (princ)
)
(princ "\nC:SEV geladen, typ SEV om te activeren. ")
(princ)
(princ)



komut ismi: sev

ehya (08.01.2009 16:16 GMT)

09.01.2009 16:27    

fleshget
Hay çok yaşa sen üstadım yau!

ehya (09.01.2009 20:55 GMT)

06.03.2009 14:37    

s_e_u
macapapazi arkadaşım sağol eline sağlık.

06.03.2009 14:55    

aslanv
macapapazi teşekkür ediyoruz. Haritacı arkadaşlar sürekli bana bu soruyu soruyorlardı. Şimdi çaresini buldum.

07.03.2009 14:07    

s_e_u
yalnız bir daire veya elips şeklindeki hatlarda döngü oluşuyor iki kere tarama yapıyor.

09.03.2009 13:03    

hasansar81
bu arada sev taramasi ne acaba

11.03.2009 09:20    

kurtsalih
teşekkürler üstadım..

17.03.2009 07:49    

ozati
Bu sev programı siteye ben eklemiştim.
Fakat başkaları sahiplenmiş gibi görüyorum.

17.03.2009 08:20    

ehya
ozati

bu lispi yazan senmisin? yoksa daha önceden ekleyen misin??

25.03.2009 11:06    

hkaradayi
lisp calıstıran varmı?
ben calıstıramadım

25.03.2009 12:28    

HIPHOP
çok güzel çılışıyor... ben düzenledim bile :D

02.04.2009 13:00    

sedat_55
mükemmel çalışıyor elinize sağlık

30.04.2009 22:29    

maarullaw74
arkaşlar slm cizimi yaptıktan sonra şekile renk veriyorum eski cizgiler kalıyor bunları yok etmenin bir yolu varmı teşekkürler

12.05.2009 13:46    

macapapazi
Kod:

defun c:sev()
;aralarına şev çizilecek polylinelar seçiliyor
;cizimokulu.com
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setq nliste1 nil)
(setq nliste2 nil)
(setq aciliste nil)
(setq sline "E")
(setq ara (getreal "lütfen iki şev çizgisi arasındaki mesafeyi giriniz:"))
(princ "lütfen sev taraması için ilk polyline seçimini yapınız:")
(setq nesne1 (entsel))
(COMMAND "LAYER" "M" "SEV1" "C" 253 "" "")
(command "measure" nesne1 ara)
(terpri)
(princ "lütfen sev taraması için ikinci polyline seçimini yapınız:")
(setq nesne2 (entsel))
(setq sline (getstring "kısa çizgiler ilk seçilen çizgi üzerinde mi?<e/h>:"))
(COMMAND "LAYER" "M" "SEV2" "C" 253 "" "")
(command "measure" nesne2 (/ ara 4))
;ilk seçilen polyline a ait nokta listesi oluşturuluyor...
(setq secim1 (ssget "X" (list (cons 0 "point") (cons 8 "SEV1"))))
(setq artsay 0)
(setq say (sslength secim1))
(repeat say
(setq ent1 (entget (ssname secim1 artsay)))
(if (= artsay 0) (setq nliste1 (list (assoc 10 ent1)))
(setq nliste1 (append nliste1 (list (assoc 10 ent1))))
)
(setq artsay (+ artsay 1))
)
(command "erase" secim1 "")
;ikinci seçilen polyline a ait nokta listesi oluşturuluyor...
(setq secim2 (ssget "X" (list (cons 0 "point") (cons 8 "SEV2"))))
(setq artsay 0)
(setq say (sslength secim2))
(repeat say
(setq ent1 (entget (ssname secim2 artsay)))
(if (= artsay 0) (setq nliste2 (list (assoc 10 ent1)))
(setq nliste2 (append nliste2 (list (assoc 10 ent1))))
)
(setq artsay (+ artsay 1))
)
(command "erase" secim2 "")
;açı listesi oluşturuluyor...
;bulunan noktaların uzerinde bulundukları doğrulara ait açılar aciliste listesine depolanıyor...
(setq say (- (length nliste1) 1))
(setq artsay 0)
(repeat say
(setq nokta1 (nth artsay nliste1))
(setq p1 (list (nth 1 nokta1) (nth 2 nokta1)))
(setq artsay (+ artsay 1))
(setq nokta2 (nth artsay nliste1))
(setq p2 (list (nth 1 nokta2) (nth 2 nokta2)))
(setq aci (angle p1 p2))
(setq aci (rtos aci 2 6))
(if (= aciliste nil) (setq aciliste (list aci)) (setq aciliste (append aciliste (list aci))))
)
;bulunan noktalar ve açılar yardımıyla noktalara dikdoğrular çizilerek kesişimleri bulunuyor...
(COMMAND "LAYER" "M" "k" "C" 2 "" "")
(setq artsay 0)
(setq say2 (- (length nliste1) 1))
(setq say3 (- (length nliste2) 1))
(setq tek 1)
(repeat say2
(setq nokta1 (nth artsay nliste1))
(setq nokta1 (list (nth 1 nokta1) (nth 2 nokta1)))
(setq aci1 (atof (nth artsay aciliste)))
(setq aci2 (+ aci1 (/ pi 2)))
(setq aci3 (- aci1 (/ pi 2)))
(setq nokta2 (polar nokta1 aci2 10000))
(setq nokta3 (polar nokta1 aci3 10000))
(princ nokta1)
(princ nokta2)
(princ nokta3)
(terpri)
(setq artsay1 0)
(setq aaa 1)
(while (= aaa 1)
   (progn
(setq vertex1 (nth artsay1 nliste2))
(setq vertex1 (list (nth 1 vertex1) (nth 2 vertex1)))
(setq artsay1 (+ artsay1 1))
(setq vertex2 (nth artsay1 nliste2))
(setq vertex2 (list (nth 1 vertex2) (nth 2 vertex2)))
(setq kes1 (inters nokta1 nokta2 vertex1 vertex2))
(setq kes2 (inters nokta1 nokta3 vertex1 vertex2))
(if (/= kes1 nil) (progn
(if (= tek 1) (command "line" nokta1 kes1 ""))
(if (= tek 0) (progn
(setq mesafe (/ (distance nokta1 kes1) 2))
(if (or (= sline "H") (= sline "h")) (setq kest kes1))
(setq kes1 (polar nokta1 aci2 mesafe))
(if (or (= sline "H") (= sline "h")) (setq nokta1 kest))
(command "line" nokta1 kes1 "")
(terpri)
      )
)
(setq aaa 2)
  )
)
(if (/= kes2 nil) (progn
(if (= tek 1) (command "line" nokta1 kes2 ""))
(if (= tek 0) (progn
(setq mesafe (/ (distance nokta1 kes2) 2))
(if (or (= sline "H") (= sline "h")) (setq kest kes2))
(setq kes2 (polar nokta1 aci3 mesafe))
(if (or (= sline "H") (= sline "h")) (setq nokta1 kest))
(command "line" nokta1 kes2 "")
(terpri)
      )
)
(setq aaa 2)
  )
)
   )
)
(if (= tek 0) (setq tek 1) (setq tek 0))
(setq artsay (+ artsay 1))
(princ artsay)
(terpri)
)
(setvar "cmdecho" 1)
(setvar "osmode" 32)
)


Şev tarama lisp dosyasını bilgisayarınıza indirip AutoCAD'e yükleyerek kullanabilirsiniz.
Şev tarama lispi indirme bağlantısı: 1-sev-tarama-lisp.lsp

admin (14.12.2017 09:14 GMT)

13.05.2009 13:33    

bud_0782
bu lispi autocade nasıl ekleyerek çalıştırabiliriz?

13.05.2009 14:28    

macapapazi
mesaj içindeki yazıyı bir text dosyanın içine kopyalarız.. daha sonra dosyanın uzantısını ".lsp " yaptıgımız zaman lisp dosyası oluşmuş olur...appload komutu ile olusturulan lisp dosyasını secer "load" deriz .komut yuklenmiş olur.Autocad içinde "sev" yazıp "enter" yaptıgımız zaman lispimiz çalışmış olur.

Kolay gelsin

13.05.2009 14:32    

bud_0782
denedim ancak başaramadım.hata nerede olabilir?dosyayı ayrıca autocad dosyalarının içine bir yere mi kopyalamak gerekir?bir yerde bir püf var ve ben mi atlıyorum acaba.daha doğrusu autocadi ilk açtığımda direk olarak komuta giriyor ve lispi çalıştırabiliyorum.ancak her şev taraması yapacağımda dosyayı kapatıp açmam gerekiyor.sev yazarak lispi çalıştıramıyorum.sorun ne olabilir ki

bud_0782 (14.05.2009 09:43 GMT)

18.02.2010 07:53    

xpitonx_54
emeğine sağlık kardeş ama senden bir ricam olacak. burda şev taraması şev üstüne dik yapılıyor.bir de bu taramanın şev altına dik olan komutuyla eklersen lisp i çok sevinirim.
belki çok kolay ama bu konuda yeniyim kusura bakma.
Saygılarımla..

Copyright © 2004-2022 SQL: 1.645 saniye - Sorgu: 102 - Ortalama: 0.01613 saniye