Plan çizimlerine iç ölçü veren lisp

Forum Menüsü

AutoCAD Genel

AutoCAD Eğitimi

3ds Max

Ziyaretçi: 480, Üye: 1
tekin

Detaylar »

Forumlar > AutoLISP > Plan çizimlerine iç ölçü veren lisp

Bu başlığı inceleyenler : 1 ziyaretçi, 0 üye : ---

İleti	Yazar
26.03.2010 15:40 56389	ProhibiT Yetkili 1611 ileti İnşaat Mühendisi Ankara
Merhaba arkadaşlar, yıllar önce yazdığım bir autolisp programın açık kodunu (düzenleyip güncelleştirerek) ilk defa burada sizlerle paylaşmak istiyorum. plan (betonarme kalıp planları, mimari kat planları,...Vb.) çizimlerinde iç ölçü vermeye yarayan bir fonksiyon. çok sevdiğim bir arkadaşım, "gözü kör mü, şuradan şuraya kadar desem, o da ölçülendirse" demişti. fonksiyonun ilk çıkış noktası bu söz olmuştu. fonksiyon çalıştırıldığında, "ölçü başlangıç noktası"nı seçmenizi ister. ilk nokta seçildikten sonra ikinci noktayı (ölçü bitiş noktası) girmeniz istenir. bu arada ekranda çıkan yardımcı çizgi ile, ölçünün nereden geçeği konusunda yönlendirilirsiniz. fonksiyon, ortogonal (yatay ya da dikey) yönde iç ölçüler vermek üzere hazırlanmıştır. ekranda çıkan yardımcı çizgi o andaki imleç konumuna göre ortogonal seçime sizi yönlendirecektir. bu şekilde plandaki çizim objelerimizin nereden başlayıp nereye kadar ölçülendirilecekleri belirlenmiş olur. yani planımızın bir ucundan başlayıp diğer ucuna kadar boydan boya ölçülendirmek zorunda değiliz. bundan sonraki adımda, ölçü hattımızın nereye yerleştirileceği belirlenecektir. "ölçünün çizileceği yeri gösteriniz mesajına" cevap verirken, doğrudan doğruya bir nokta seçebileceğiniz gibi, mevcut bir ölçüden standart dimension ıncrement (dımdlı değişkeni) kadar uzaklıkta yeni bir ölçü hattı oluşturmak isterseniz, enter (veya sağ tuş) girmeniz yeterlidir. program sizden (mevcut) referans ölçüsünü seçmenizi isteyecek, bundan sonrada yeni ölçü takımını referansın hangi tarafına yerleştireceğinizi belirlemek için bir nokta daha seçmeniz istenecektir. sıradaki işlem, ölçülerin referans noktalarının (dimension definition point) hangi hizada olacaklarını belirlemektir. burada da, definition point'lerin mevcut bir ölçü ile aynı olmasını isterseniz, gene enter (ya da sağ tuş) girip, mevcut ölçüyü seçmeniz gerekecek. definition point'lerin bu şekilde kullanıcı kontrollü olarak yerleştirilmesi, daha sonra ölçülerimizi edit ederken, definition point ile dimension line location point'lerin çakışmasını önlemek amaçlıdır. aksi halde gripler üstüste çakışacağından, edit ederken sıkıntılar yaşanabilir. buna rağmen siz öyle tercih ederseniz dimension line location ile definiton point yerlerini aynı hizada seçebilirsiniz. son işlemimiz, ölçülendirmeye dahil edilecek objelerimizin (duvar, sıva, kolon, kiriş,... vb.) bulunduğu layer'ları seçme işlemidir. yalnızca seçtiğimiz layer(lar)'daki objeler ölçülendirilir. bir tek layer seçebileceğimiz gibi, birden fazla layer'da seçebiliriz. bu seçim işlemini, seçmek istediğimiz layerda yer alan bir objeyi seçerek yapıyoruz. enter (veya sağ tuş) girerek seçimizi sonlandırıyoruz. özet olarak, duvardan duvara ölçüler verebileceğimiz gibi, duvarlarla birlikte, mesela aks layer'ındaki objelerimizi de ölçülendirebiliyoruz. seçtiğimiz layer(lar)'da yer alan objelerimizden, lıne veya polylıne olanlar ölçülendirmeye dahil edilirler. block'lar ve bunların alt objeleri ölçülendirmeye dahil edilmezler. kullanımda, sizden bir seçim yapmanız istendiğinde, karasız kalırsanız enter (ya da sağ tuş) girdiğinizde yeni seçim alternatifleri sunulur. fonksiyon, geçerli layer ve geçerli dimensiyon style'ı kullanarak ölçülendirme yapar. kullanıcının, dimension style ve layer düzenine hiç bir şekilde müdahale etmez. mevcut ölçülerden referans alarak ölçü yeri belirlenirken, dımdlı sistem değişkeninizin 0 (sıfır) olmamasına dikkat etmenizi tavsiye ederim. herkese kolay gelsin. Kod: ;;;============================================================== ;;; DIMINT: Plan Çizimlerinde İç Ölçü verme işini yapar ;;; Hazırlayan M. S. Güvercin sahinguvercin@hotmail.com ;;;============================================================== (defun C:DIMINT () (setvar "cmdecho" 0) (cpr1) (command "undo" "group") (setq nk1 (getpoint "\nOlcu baslangic noktasini seciniz... ") x1 (car nk1) y1 (cadr nk1) espas (* (getvar "dimscale") (getvar "dimdli"))) (princ "\nOlcu Bitis noktasini seciniz... ") (while (/= 3 (car (setq nk2 (grread T 4 1)))) (setq nk2 (cadr nk2) x2 (car nk2) y2 (cadr nk2) dx (abs (- x1 x2)) dy (abs (- y1 y2))) (if (> dx dy) (grdraw nk1 (list (car nk2) (cadr nk1)) -1 0) (grdraw nk1 (list (car nk1) (cadr nk2)) -1 0))) (setq nk2 (cadr nk2) x2 (car nk2) y2 (cadr nk2) dx (abs (- x1 x2)) dy (abs (- y1 y2))) (if (> dx dy) (setq yon "x") (setq yon "y")) (setq yer (getpoint "\nOlcunun cizilecegi yeri gosteriniz... ")) (if (= nil yer) (progn (setq rd (entget (car (entsel "\nReferans olcusunu seciniz... "))) yr (cdr (assoc 10 rd)) tr (getpoint "\nYeni olcu Referansin hangi tarafinda :")) (cond ((= yon "x") (progn (if (> (cadr tr) (cadr yr)) (setq y (+ (cadr yr) espas)) (setq y (- (cadr yr) espas))) (setq yer (list (car yr) y)))) ((= yon "y") (progn (if (> (car tr) (car yr)) (setq x (+ (car yr) espas)) (setq x (- (car yr) espas))) (setq yer (list x (cadr yr)))))))) (setq ryr (getpoint "\nOlcu referans noktalarinin yeri...")) (if (= nil ryr) (progn (setq rd (entget (car (entsel "\nReferans olcusunu seciniz... ")))) (if (= (cdr (assoc 0 rd)) "DIMENSION") (setq ryr (cdr (assoc 14 rd)))))) (if (= yon "x") (setq y1 (cadr ryr) y2 (cadr ryr)) (setq x1 (car ryr) x2 (car ryr))) (setq n1 (list x1 y1) n2 (list x2 y2) onsec (ssget "c" n1 n2) l (sslength onsec) n 0) (while (< n l) (setq obtyp (cdr (assoc 0 (entget (ssname onsec n))))) (if (and (/= obtyp "LINE") (/= obtyp "LWPOLYLINE")) (setq onsec (ssdel (ssname onsec n) onsec) l (1- l)) (setq n (1+ n)))) (setq l (sslength onsec) olcob (ssadd)) (while (setq nob (car (entsel "\nIlgili layer da bir obje seciniz... "))) (setq nob (entget nob) la (cdr (assoc 8 nob)) n 0) (while (< n l) (if (= la (cdr (assoc 8 (entget (ssname onsec n))))) (if (ssmemb (ssname onsec n) olcob) (progn (ssdel (ssname onsec n) olcob) (redraw (ssname onsec n) 4)) (progn (ssadd (ssname onsec n) olcob) (redraw (ssname onsec n) 3)))) (setq n (1+ n)))) (setq l (sslength olcob) n 0 noks nil) (while (< n l) (setq srdk (ssname olcob n) n (1+ n)) (redraw (ssname olcob (1- n)) 4) (cond ((= "LWPOLYLINE" (cdr (assoc 0 (entget srdk)))) (poly)) ((= "LINE" (cdr (assoc 0 (entget srdk)))) (cizgi)))) (setq nks (vl-sort noks '<) noks nil) (while (> (length nks) 1) (setq noks (cons (nth 0 nks) noks) nks (vl-remove (nth 0 nks) nks))) (setq noks (cons (nth 0 nks) noks) l (length noks) m 0) (while (< m l) (cond ((= yon "x") (setq noks (subst (list (nth m noks) y1) (nth m noks) noks))) ((= yon "y") (setq noks (subst (list x1 (nth m noks)) (nth m noks) noks)))) (setq m (1+ m))) (setq m 0) (while (< m (1- l)) (setq p1 (nth m noks) p2 (nth (1+ m) noks) ang (angle p1 p2)) (entmake (list (cons 0 "DIMENSION") (cons 100 "AcDbEntity") (cons 67 0) (cons 100 "AcDbDimension") (cons 10 yer) (cons 70 32) (cons 100 "AcDbAlignedDimension") (cons 13 p1) (cons 14 p2) (cons 50 ang) (cons 100 "AcDbRotatedDimension"))) (setq m (1+ m))) (command "undo" "e") (cpr2) (prin1) ) (defun error (e) (princ er) (cpr2) (prin1)) (defun cpr1 () (grtext -1 "Prepared by: M.S.GUVERCiN") (prin1)) (defun cpr2() (grtext) (prin1)) (defun poly () (setq pln (entget srdk) sx1 (cadr (assoc 10 pln)) sy1 (caddr (assoc 10 pln)) n5 (list sx1 sy1) pln (subst (list 11 (cdr (assoc 10 pln))) (assoc 10 pln) pln)) (while (assoc 10 pln) (setq sx2 (cadr (assoc 10 pln)) sy2 (caddr (assoc 10 pln)) n3 (list sx1 sy1) n4 (list sx2 sy2) intr (inters n1 n2 n3 n4 T)) (if intr (if (= yon "x") (setq noks (cons (car intr) noks)) (setq noks (cons (cadr intr) noks)))) (setq sx1 sx2 sy1 sy2 pln (subst (list 11 (cdr (assoc 10 pln))) (assoc 10 pln) pln))) (if (= 1 (cdr (assoc 70 pln))) (progn (setq intr (inters n1 n2 n4 n5 T)) (if intr (if (= yon "x") (setq noks (cons (car intr) noks)) (setq noks (cons (cadr intr) noks)))))) ) (defun cizgi () (setq sx1 (cadr (assoc 10 (entget srdk))) sy1 (caddr (assoc 10 (entget srdk))) sx2 (cadr (assoc 11 (entget srdk))) sy2 (caddr (assoc 11 (entget srdk))) n3 (list sx1 sy1) n4 (list sx2 sy2)) (setq intr (inters n1 n2 n3 n4 T)) (if intr (if (= yon "x") (setq noks (cons (car intr) noks)) (setq noks (cons (cadr intr) noks)))) ) Düzenleme Notu: Harbi65 arkadaşımızın uyarısı üzerine, Kapalı olmayan PolyLine objeleriyle ilgili düzeltme ve dünzenleme yapıldı... (if (= 1 (cdr (assoc 70 pln))) (setq intr (inters n1 n2 n4 n5 T))) Bölümü eklenerek PolyLine objesinin kapalı olup olmadığı kontrol edilmesi sağlandı. yeni düzenleme: konunun sonunda açıkladığım ekleme ve düzeltmeler yapıldı. ölçülendirilecek line ve polyline objelerinden üstüste olanlar varsa, kontrol edilerek hatalı ölçülendirme engellendi. ProhibiT (30.09.2011 06:11 GMT) Beğenmek için anlamak lazım...

26.03.2010 16:19 56390	Harbi65 Üstad 428 ileti İnş.Tekn. Teknik Ressam KASTAMONU
Hocam Eline sağlık güzel, kullanışlı olmuş... Pline çizgide bi karışıklık oluyor ama ölçülendiyor.

26.03.2010 20:46 56394	ProhibiT Yetkili 1611 ileti İnşaat Mühendisi Ankara
Teşekkür ederim Harbi65 hocam. PLine çizgideki problemi anlayamadım, uzun zamandır kullanılıyor hiç böyle bir hata bildirilmedi bana. Mesajınızı okuduktan sonra tekrar baktım bir problem göremedim. Beğenmek için anlamak lazım...

26.03.2010 21:19 56395	Harbi65 Üstad 428 ileti İnş.Tekn. Teknik Ressam KASTAMONU
Aslında bende anlamadım. İşyerinde denedim, pline olan balkon çizgilerinde anlamsız ölçüler verdi... Biraz önce evde denedim bi sorun çıkarmadı... -İlgili Layer nesne seçimi nil olduğunda döngü olsa daha iyi olmaz mı? Böyle durumda nil olup sonlanıyor... -Burada ki; (grread T 4 2)))) 2 olan değeri 1 yaparsak uygulamada daha kullanışlı olacağını düşünüyorum...

27.03.2010 00:17 56399	ProhibiT Yetkili 1611 ileti İnşaat Mühendisi Ankara
Detaya girince sonunu bulamıyorum :) Yazdığınız gibi nesne seçimi kontrollü yapılabilir, grread'de 2 yerine 1 kullanılabilir elbette. Hiç aklıma gelmedi, renk olarak Xorink kullandım ama highlight düşünmedim, ilk aklıma geleni yazmışım doğrusu. Seçilen Layer(lar)'daki objelerden hiç birinin Ölçü Hattı ile intersection'u bulunamazsa, Entmake Dimension komutuna tanımsız parametrelerle giriyor, daha feci bir şekilde bitiyor program :) Seçili olan Layer yeniden seçilince, "Hoop, Zaten seçili" demiyor, yeni Layer seçilmiş gibi devam ediyor. Ölçülendirmeye dahil edilecek objelerin Layer'ları belirlenirken, Seçilen Layer'daki tüm objeleri HighLight etmeyi ve Seçim sırasında, Layer iptal edebilmeyi, ekleme çıkarma yapmayı da düşündüm, ama üşendim açıkçası. Harbi65 hocam yorumlarınız için teşekkür ederim. Kolay gelsin... Düzenleme: Harbi65 hocam, Gönderdiğiniz çizim üzerinde fonksiyonu test ettim, siz tamamen haklısınız. Fonksiyon, PolyLine objelerini daima kapalı gibi algılıyordu, bu durumda, Başlangıç ve bitiş noktaları arasında da bir çizgi varmış gibi intersection buluyordu. PolyLine objelerinin kapalı ya da açık olmaları durumunu kontrol edecek şekilde düzenledim problem halloldu. Bu arada GrRead fonksiyonunda da 1 kullandım böylelikle pickbox görünmüyor, daha hoş oldu... Bunca zamandır bu fonksiyonu kullanan onca insanın bulamadığı bir programatik açığı yakalamamı sağladığınız için özellikle teşekkür etmek istiyorum :) ProhibiT (28.12.2010 09:14 GMT) Beğenmek için anlamak lazım...

29.03.2010 11:11 56446	Harbi65 Üstad 428 ileti İnş.Tekn. Teknik Ressam KASTAMONU
Bende teşekkür ederim ilgilendiğiniz için... Pline probleminin çözülmesi çok iyi oldu... Elinize sağlık. * Bu kod da şunuda yapabilsek süper olacak ama bu kolay bişey olmaz... Ölçümüz kapı boşluğu üzerinden geçiyorsa duvar katmanını seçtiğimizde bu boşlukta da duvar kalınlığını ölçilendirme yapabilse harika olurdu... Tabi bu düşüncenin fazla abartı olduğunu biliyorum...:) Harbi65 (29.03.2010 11:20 GMT)

30.03.2010 20:05 56495	ProhibiT Yetkili 1611 ileti İnşaat Mühendisi Ankara
Harbi65 hocam, Kapı boşluğu ile ilgili kısmı henüz çözemedim, aklımda bir şeyler var, ilham gelince yazarım:) Ama, başka şeyleri geliştirip değiştirdim. Forumda daha fazla yer işgal etmemek ve yeni kullanacak arkadaşlar açısından eski - yeni kargaşasını önlemek düşüncesiyle mevcut kodu güncelledim. Tekrar denerseniz beğeneceğinizi umuyorum. Değerli katkılarınızla fonksiyon daha güzel ve kullanışlı hale geldi. 1- PolyLine objelerinde küçük bir hata daha vardı, düzeltildi. 2- Ölçülendirmeye dahil edilecek Layer'da bir obje seçildiğinde, Ölçü hattı ile intersection'u olan o Layer'daki objeler HighLight ediliyor. Böylelikle ölçülendirilecek objeler net olarak görülebiliyor. 3- HighLight edilmiş objenin bulunduğu Layer'daki bir obje tekrar seçilirse, HighLight kaldırılıyor ve o Objeler ölçülendirilecekler listesinden çıkarılıyor. Selamlar, Sevgiler, Herkese Kolay Gelsin... Beğenmek için anlamak lazım...

01.04.2010 09:33 56520	Harbi65 Üstad 428 ileti İnş.Tekn. Teknik Ressam KASTAMONU
ProhibiT hocam eline sağlık. Yeni test etme fırsatı bulabildim. Şuan gayet kullanışlı olmuş. Aynı layer tekrar seçildiğinde iptal etmesi güzel bi özellik olmuş... elinize sağllık... İlham gelir de kapı boşlukları konusunda da çözüm üretirseniz çok güzel olacak. Hocam şimdi aklıma geldi. Bunda bi düzenleme daha yapabilirsek iyi olcak... Şuan sadece 0, 90, 180, 270 açılarda ölçülendirme yapıyor. Gread fonksiyonu bu ölçülere kilitleniyor ve dolayısıyla bu açıda ölçüler veriyor.. Gread fonksiyonu Snapangle açısına göre çalışırsa daha doğru olacağını düşünüyorum... Bana göre bu kapı boşluğundan daha önemli... Kolay gelsin. Harbi65 (01.04.2010 09:52 GMT)

02.04.2010 07:35 56537	ProhibiT Yetkili 1611 ileti İnşaat Mühendisi Ankara
Harbi65 hocam, Ölçülendirilecek objeleri seçerken, L gir Layer seç, O gir Obje Seç, E gir Ekle, C gir Çıkar gibi bir seçim yapmayı pratik bulmadım. Aklımdan geçen Mevcut durumda olduğu gibi Layerlardan Obje seçerken, mesela Shift veya Alt tuşuna basınca seçtiğim objenin ölçü hattıyla intersection'u olmayan, kapı boşluğu objesi olduğunu anlasın ve seçili Layer'da olmasa bile o objeyi ölçüye dahil etsin diye düşünmüştüm. Pek geçerli bir çözüm bulamadım. ehya hocamın da fikrini almak istiyorum entsel ile seçim yaparken Shift, Alt ya da Ctrl tuşlarının veya bunların kombinasyonalrının bir etkisi olmuyor. entsel'e benzer başka bir komut var mıdır acaba? Beğenmek için anlamak lazım...

18.10.2010 18:11 60180	gkazanci Girişimci 12 ileti mimar kayseri
Merhabalar Prohibit Yazdığın lisplere hayranlığımı belirteyim öncelikle çok başarılı lispler. Bu lisp ile ilgili şöyle bir sorun var belirtmek istedim. ucs farklı bir şekilde tanımlanmış ise çalışmıyor. Neden bilmiyorum fakat ucs i kendim tanımladığım zaman ölçüleri vermiyor. Bilgi vermek istedim. Kolay gelsin.

18.10.2010 19:33 60182	ProhibiT Yetkili 1611 ileti İnşaat Mühendisi Ankara
Teşekkür ederim gkazancı... Bu fonksiyonun dediğiniz gibi bazı eksikleri var. İşin doğrusu, o anda aktif olan UCS kontrol edilip WCS değilse Transfer matrisiyle çevirmek gerekiyor. Biraz üşenmekten biraz da vakit ayıramamaktan bu tür eski AutoLisp fonksiyonlarımı elden geçirip güncelleştiremiyorum :) Bu fonksiyonun yazılış tarihi 1988. Burada paylaşmak için elden geçirmiştim. Sağolsun bazı arkadaşların bulduğu birtakım aksaklıkları da giderdikten sonra öksüz kaldı garibim :) Marifet iltifata tabîdir, talebi olmayan marifet zayidir... misali Kolay Gelsin... ProhibiT (25.06.2020 15:47 GMT) Beğenmek için anlamak lazım...

25.10.2010 07:40 60304	gkazanci Girişimci 12 ileti mimar kayseri
Teşekkürler bilgilendirme için. Gerçekten çok işe yarayabilecek bir lisp olmuş bence. Bazen anlam veremediğim şekilde eksik veriyor ölçüleri ama :) yinede buda işimizi görüyor.Teşekkürler.

25.10.2010 09:31 60309	bud_0782 Üstad 322 ileti Yapı Öğr.+Teknik Res. Antalya
kullanışlı bir lisp olmuş. teşekkürler.emeğinize sağlık ~~~~~~~~~~~~~~~~~~~~~~~~ Düşün , hisset, uygula… İşte hepsi bu… ~~~~~~~~~~~~~~~~~~~~~~~~

25.10.2010 16:44 60320	ProhibiT Yetkili 1611 ileti İnşaat Mühendisi Ankara
Alıntı gkazanci : ... Bazen anlam veremediğim şekilde eksik veriyor ölçüleri ... Demişsiniz, bu tür durumlarda ölçülendirdiğiniz çizgiler içinde üstüste olanlar vardır. Express Tools->Modify->Delete duplicate objects (yani overkill) uygulayıp üstüste objeleri temizlerseniz, fonksiyon hata vermeyecektir. Bu tür durumu fonksiyon içinden kontrol edecek bir düzenleme yapmayı düşündüm ama bir türlü vakit bulamadım :) Kolay gelsin... Bahsettiğim düzenlemeyi ekledim, başlangıçta verdiğim kodu tekrar indirip denerseniz, üstüste gelen objelerden dolayı hata oluşmayacaktır... ProhibiT (25.10.2010 19:47 GMT) Beğenmek için anlamak lazım...

26.10.2010 06:41 60328	gkazanci Girişimci 12 ileti mimar kayseri
Çok teşekkürler hemen deneyeceğim :)

26.10.2010 14:16 60345	ProhibiT Yetkili 1611 ileti İnşaat Mühendisi Ankara
AutoLisp ve VisualLisp ile ilgilenen arkadaşlar için; Daha önce seçili noktaları sıralamak için içi içe 2 loop kullanıyordum, oldukça uzun bir yol idi. (setq nks (vl-sort noks '<) noks nil) vl-sort komutuyla tek komutla bu sıralamayı yapabiliyoruz. Üstüste çizgilerden gelen biribirinin aynı değere sahip noktalar olduğunda, başlangıç ve bitiş noktaları arası 0 (sıfır) olan bir dimension objesi yapılmaya çalışıldığından hata oluşuyordu. Bu problemi de, (while (> (length nks) 1) (setq noks (cons (nth 0 nks) noks) nks (vl-remove (nth 0 nks) nks))) (setq noks (cons (nth 0 nks) noks) l (length noks) m 0) şeklinde basit bir yolla çözdüm... Herkese Kolay Gelsin. Beğenmek için anlamak lazım...

04.01.2011 19:05 61857	safahat Girişimci 2 ileti serbest manisa
çok teşekkürler

05.03.2011 22:06 63185	ProhibiT Yetkili 1611 ileti İnşaat Mühendisi Ankara
Merhaba arkadaşlar, Bu başlık altında paylaşmış olduğum DIMINT ve benzeri fonksiyonlarla birlikte, uzun yıllardır Dimension objelerini düzenlemek için kullandığım 2 fonksiyon daha paylaşmak istiyorum. her iki fonksiyon da, lineer dimension (aligned, horizontal, vertical ve rotated) objeleri üzerinde işlem yapar. diğer türdeki dimension objelerini işleme almazlar. Kod: ;;;================================;;; ;;; Hazırlayan: M. Şahin Güvercin ;;; ;;;================================;;; (defun C:DIMYER () (setvar "cmdecho" 0) (command "undo" "group") (princ "\nYeri Degiştirilecek ölçüleri seçiniz ") (setq ydd (ssget (list (cons 0 "DIMENSION"))) n1 (getpoint "\nYeni yer... ") L (sslength ydd) n -1) (while (< (setq n (1+ n)) L) (setq rd (entget (ssname ydd n)) rd (subst (cons 10 n1) (assoc 10 rd) rd)) (entmod rd) (entupd (cdr (assoc -1 rd)))) (command "undo" "e") (prin1) ) İlk fonksiyonumuz DIMYER adından da anlaşılacağı gibi Dimension'ların yerlerini düzenleme işini yapar. definition point'ler değiştirilmez olduğu gibi bırakılır, yalnızca dimension line'ların yeri seçilen noktaya hizalanır. Kod: ;;;================================;;; ;;; Hazırlayan: M. Şahin Güvercin ;;; ;;;================================;;; (defun C:DIMHIZ () (setvar "cmdecho" 0) (command "undo" "group") (princ "\nDefinition Point'leri düzenlenecek ölçüleri seçiniz ") (setq ydd (ssget (list (cons 0 "DIMENSION"))) L (sslength ydd) n -1) (initget 1) (setq n0 (getpoint "\nDefinition Point için yeni yer...")) (while (< (setq n (1+ n)) L) (setq rd (entget (ssname ydd n)) a2 nil n1 (cdr (assoc 13 rd)) n2 (cdr (assoc 14 rd)) n0 (list (car n0) (cadr n0) (caddr n1)) n2 (list (car n2) (cadr n2) (caddr n1)) rd70 (cdr (assoc 70 rd))) (while (>= rd70 32) (setq rd70 (- rd70 32))) (cond ((= rd70 0) (setq a1 (cdr (assoc 50 rd)) a2 (+ a1 (/ pi 2)))) ((= rd70 1) (setq a1 (angle n1 n2) a2 (+ a1 (/ pi 2))))) (if a2 (progn (setq n3 (polar n1 a2 1) n4 (polar n2 a2 1) n5 (polar n0 a1 1) nn1 (inters n1 n3 n0 n5 nil) nn2 (inters n2 n4 n0 n5 nil) rd (subst (cons 13 nn1) (assoc 13 rd) rd) rd (subst (cons 14 nn2) (assoc 14 rd) rd)) (entmod rd) (entupd (cdr (assoc -1 rd)))))) (command "undo" "e") (prin1) ) İkinci fonksiyonumuz DIMHIZ gene adından anlaşılacağı gibi seçilen dimension objelerinin Extension Line'larını hizalar. bu fonksiyon seçilen objeler gurubu içindeki dimension objelerinin definition point'lerini, seçilen noktaya göre bir hizaya getirir. dimesin line'ların yerlerini değiştirmez. kolay gelsin. ProhibiT (05.07.2011 18:50 GMT) Beğenmek için anlamak lazım...

16.09.2011 09:05 65796	Beyda Girişimci 1 ileti inşaat teknikeri istanbul
Bu lispi nerde bulacağız :)

16.09.2011 11:37 65797	ProhibiT Yetkili 1611 ileti İnşaat Mühendisi Ankara
Zaten açık kod verilmiş. yani burada bulacaksınız... :) bunu nasıl alıp kullanacağınız konusunda sitemizde detaylı açıklamalar var, kısa bir araştırma yapmalısınız. Beğenmek için anlamak lazım...

> 1 < [2]

Sonraki Sayfa