Elemanlara numara verme | Forumlar

Forum Menüsü

AutoCAD Genel

AutoCAD Eğitimi

3ds Max

Ziyaretçi: 479, Üye: 4
Dalsarkar, halilguler80, mttlp, ProhibiT

Detaylar »

Forumlar > AutoCAD Acil Yardım > Elemanlara numara verme

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

İleti	Yazar
15.02.2011 08:11 62684	ibocompany Kıdemli Girişimci 23 ileti inşmüh ankara
Alttaki lispte rectangle lara numara veriyor. ama ilk yapılış sırasına göre. bu sıralamayı kolon numarası verir gibi yukardan aşşağı sırayla yapmasını sağlayamazmıyız? Kod: (vl-load-com) (defun text_at_middle_of_line () (setq myset (ssget ":n" (list (cons 0 "lwpolylıne") ) ) ) (setq index 0) (setq n (sslength myset)) (repeat n (setq reversed_index (- (- n index) 1)) (setq enlist (entget (ssname myset reversed_index))) (setq insert_point (cdr (assoc 10 enlist))) (setq number_string (vl-princ-to-string (+ index 1))) (entmake (text_out insert_point number_string ) ) (setq index (+ index 1)) ) (princ insert_point) ) (defun text_out ( pt txt / text_entity ) (setq text_entity (list '(0 . "text") (cons 10 pt) (cons 11 pt) (cons 1 txt) (cons 50 0.0) (cons 40 2.5) (cons 62 7) (cons 72 1) (cons 73 2) ) ) text_entity ) (defun c:tm () (text_at_middle_of_line) (princ) )

15.02.2011 11:31 62689	ProhibiT Yetkili 1612 ileti İnşaat Mühendisi Ankara
Keşke doğrudan sorunuzu sorsaydınız! yazdığınız kod sorunuzu desteklemediği gibi, yanlış ve dolambaçlı olduğundan sorunuzun kaynayıp araya gitmesine sebep olmuş. - (vl-load-com) - hiç bir anlamı yok, gereksiz! - (ssget ":n" (list (cons 0 "lwpolylıne")))) - ":n" ifadesi çok ilgisiz! neden kullanıldı? hiç bir anlamı yok. - seçim setinin eleman sayısı bulunup böyle ilgisiz bir loop, üstelik bu kadar uzun yoldan neden kurulur ki? üstelik loop sayacı ascending order iken descending order pivot obje alınıyor, bunun için de hiç gereği olmayan işlemler yapılıyor. - (entmake (text_out insert_point number_string)) - neden basit bir atama işlemi için ayrı bir fonksiyon yazılır, 2 parametre gönderilip hem fonksyiona hem parametreye işkence etmenin ne gereği var? - (defun text_out... - bu fonksyionun gereksiz olduğunu yazmıştım. tek bir setq fonksyionundan oluşan fonksyion gereksiz olduğu gibi, setq fonksyionu zaten ifadenin sonucunu üretecekken, setq dan sonra text_entity parametresini bir de dönüş yolunda koşturmak iki defa gereksiz olmuş. - (defun c:tm () (text_at_middle_of_line) (princ)) - şeklinde, fonksyion çağıran tek bir komuttan oluşan fonksiyon neden yazılsın ki? - yazdığım belli başlı bariz ve galiz hataların dışında, hemen her satırda gereği ve anlamı olmayan ifadeler ve yanlış kullanımlar var. Kod: (defun c:tm (/ myset l n insert_point number_string) (setq myset (ssget (list (cons 0 "lwpolylıne"))) l (sslength myset) n -1) (while (< (setq n (1+ n)) l) (setq insert_point (cdr (assoc 10 (entget (ssname myset n)))) number_string (itoa (1+ n))) (entmake (list (cons 0 "text") (cons 10 insert_point) (cons 11 insert_point) (cons 1 number_string) (cons 50 0.0) (cons 40 2.5) (cons 62 7) (cons 72 1) (cons 73 2)))) (prin1) ) şeklinde kısa, sade bir şekilde yazılabilecek fonksiyonun rectangle ile uzak yakın bir ilgisi yok. seçim seti içinden aldığı bir polyline'ın yakaladığı ilk vertex noktasına artan sırada numara verebilir. ssget ile seçim seti oluşturulduğunda, set içindeki objelerin sırası, creation order'ın tersidir. sözün özü, bu kodu tamamen atın, unutun... anahtar deliğinden bakarken koca binayı görememek gibi olmuş. numara yazılarının yazılacağı noktaları, x koordinatlarına göre artan sırada satıra, y koordinatlarına göre de azalan sırada sütuna gelecek şekilde matrix formunda 2 boyutlu bir diziye yerleştirin. oluşturduğunuz 2 boyutlu matrix'i column-order düzeniyle tek boyutlu diziye açtığınızda, istenen düzende numaralar yerleşmiş olacaktır. kolay gelsin. Beğenmek için anlamak lazım...

16.02.2011 09:05 62701	ibocompany Kıdemli Girişimci 23 ileti inşmüh ankara
Matrix column-order olayını biraz inceledimde beni baya baya bi aşan konuymuş. sıralama yaptırma işini beceremedim.

18.02.2011 13:53 62765	ProhibiT Yetkili 1612 ileti İnşaat Mühendisi Ankara
Alıntı ibocompany : matrix column-order olayını biraz inceledimde beni baya baya bi aşan konuymuş. sıralama yaptırma işini beceremedim. bahsettiğim şekilde matris kurup, bunu satır veya kolon düzeninde tek boyutlu diziye açma mantığını gösteren örnek bir fonksiyon yazdım. bu tür fonksiyonları genel yazmak gerek. sınırlı bir amaca yönelik fonksiyon yazmanın bir anlamı yok, bırakın fonksiyonu script veya macro lüks kalır. bu bakımdan, fonksiyon kullanıcı ayarlarını (mesela object snap settings gibi) değiştirmemeli, yazı yüksekliğini de kullanıcı kendi seçebilmeli, kullanıcıya gereken saygıyı gösterdikten sonra da, gerçekten bir algoritma olmalı. asker gibi sıralı işlemleri sıradan yapan program parçalarına program ya da fonksiyon demek bu kavramlara hakaret olur. "yukarıdan aşağı doğru" şeklindeki bir ifade hem tanımsız hem genel değil. bu bakımdan örnek fonksiyonu, hem satır düzeninde (soldan sağa ve yukarıdan aşağı) hem de sütun düzeninde (yukarıdan aşağı ve soldan sağa) sıralama yapacak şekilde yazdım. - kolon düzeninde numaralandırma - - satır düzeninde numaralandırma - defalarca bahsettiğim gibi, algoritma konusunda örnek olması için yazılmış bir fonksiyondur, ekrandan seçilen noktaları istenen sıralama düzenine göre numaralar. bu algoritma aynen kullanılarak çok farklı uygulamalar yapılabilir. lutfen kimse benden, bu fonksiyonu şöyle değiştirsek, bunu da yapsa gibi isteklerde bulunmasın. Kod: (defun c:mtrxnum (/ Txh num dzn pts pvt pvt0 Mtrx XLer YLer StrS StnS bbx ycap L m n) ;;; Numaralandırma işlemi için Yazı Yüksekliği ve Başlangıç numarasının belirlenmesi. (if (= eTxH nil) (setq eTxH (* (getvar "dimtxt") (getvar "dimscale")))) (setq TxH (getreal (strcat "\nYazi yuksekligi <" (rtos eTxH) "> :"))) (if (= TxH nil) (setq TxH eTxH) (setq eTxH TxH)) (if (= enum nil) (setq enum 1)) (setq num (getint (strcat "\nBaslangic sayisi <" (itoa enum) "> :"))) (if (= num nil) (setq num enum)) ;;; Numaralandırmada takip edilecek sıralama kriterinin belirlenmesi. ;;; Satır düzeninde, soldan saga - yukarıdan aşağı sıralamasıyla numaralar yazılır. ;;; Sütun düzeninde, yukarıdan aşağı - soldan sağa sıralamasıyla numaralar yazılır. (initget 7 "satiR sutuN") (setq dzn (strcase (getkword "\Numaralandırma düzeni (R=satiR / N=sütuN): ")) pts nil pvt nil Mtrx nil) (while (setq pt (getpoint "\n Select point")) (setq pts (append pts (list pt)))) ;;; Burada örnek olması için ekrandan seçilen noktalardan bir set oluşturuyoruz, ;;; ve bunları pts adlı listede topladık. Kullanılcak fonksiyonda bunlar, ;;; PoLyLine veya başka tür objelerden alınacak assoc 10 değerleri olacaktır. (setq pts (mapcar '(lambda (xy) (list (car xy) (cadr xy))) pts) ;;; Pts dizini içinde kullanmayacağımız Z koordinatlarını kaldırdık. XLer (mapcar '(lambda (xx) (car xx)) pts) ;;; Noktalarımızın X koordinatlarını XLer adlı diziye aldık. YLer (mapcar '(lambda (yy) (cadr yy)) pts)) ;;; Noktalarımızın Y koordinatlarını YLer adlı diziye aldık. (setq L (length Xler) n -1) (while (< (setq n (1+ n)) L) (setq pvt0 (nth n XLer) pvt (vl-remove pvt0 XLer) XLer (append (list pvt0) pvt) L (length XLer))) ;;; XLer'in içinde tekrarlayan değerleri ayıkladık. ;;; Yani, noktaları sütunlarına göre guruplandırdık. (setq L (length YLer) n -1) (while (< (setq n (1+ n)) L) (setq pvt0 (nth n YLer) pvt (vl-remove pvt0 YLer) YLer (append (list pvt0) pvt) L (length YLer))) ;;; YLer'in içindeki tekrarlayan değerleri ayıkladık. ;;; Yani noktaları satırlarına göre guruplandırdık. (setq XLer (vl-sort XLer '<) ;;; Satırları YLer dizisinin azalan sırasına göre, YLer (vl-sort YLer '>) ;;; Sütunları XLer dizisinin artan sırasına göre sıraladık. StnS (length XLer) ;;; Satır ve StrS (length YLer) ;;; Sütun sayımızı belirledik. m -1) (cond ((= dzn "SATIR") ;;; İki boyutlu matrisimizi satır düzenine göre tek boyutlu diziye açıyoruz. (while (< (setq m (1+ m)) StrS) (setq n -1) (while (< (setq n (1+ n)) StnS) (setq Mtrx (append Mtrx (list (list (nth n XLer) (nth m YLer)))))))) ((= dzn "SUTUN") ;;; İki boyutlu matrisimizi sütun düzenine göre tek boyutlu diziye açıyoruz. (while (< (setq m (1+ m)) StnS) (setq n -1) (while (< (setq n (1+ n)) StrS) (setq Mtrx (append Mtrx (list (list (nth m XLer) (nth n YLer))))))))) ;;; İki boyutlu diziye açılam matris elemanlarından, ;;; nokta listesinde karşılığı olmayanların elenmesi. (setq L (length Mtrx) n -1) (while (< (setq n (1+ n)) L) (if (= (vl-position (nth n Mtrx) pts) nil) (setq Mtrx (vl-remove (nth n Mtrx) Mtrx) L (length Mtrx) n (1- n)))) ;;; Koordinatları ve sıralamaları belli olan noktalara numaraların yazılması. (setq L (length Mtrx) n -1) (while (< (setq n (1+ n)) L) (entmake (list (cons 0 "TEXT") (cons 10 (nth n Mtrx)) (cons 40 TxH) (cons 11 (nth n Mtrx)) (cons 1 (itoa (+ num n))) (cons 50 0) (cons 72 4))) (setq bbx (textbox (entget (entlast))) ycap (/ (distance (car bbx) (cadr bbx)) 1.5)) (entmake (list (cons 0 "CIRCLE") (cons 10 (nth n Mtrx)) (cons 40 ycap)))) (setq enum (+ num n)) ;;; Hangi numarada kaldığımızı unutmuyoruz ki; ;;; Fonksiyonu tekrar çalıştırıp kaldığımız yerden ;;; Numarlandırmaya cevam edebilelim. (prin1) ) açıklamalara ihtiyaç duymayan, kestirmeden denemek, test etmek isteyenler için; Kod: (defun c:mtrxnum (/ Txh num dzn pts pvt pvt0 Mtrx XLer YLer StrS StnS bbx ycap L m n) (if (= eTxH nil) (setq eTxH (* (getvar "dimtxt") (getvar "dimscale")))) (setq TxH (getreal (strcat "\nYazi yuksekligi <" (rtos eTxH) "> :"))) (if (= TxH nil) (setq TxH eTxH) (setq eTxH TxH)) (if (= enum nil) (setq enum 1)) (setq num (getint (strcat "\nBaslangic sayisi <" (itoa enum) "> :"))) (if (= num nil) (setq num enum)) (initget 7 "satiR sutuN") (setq dzn (strcase (getkword "\Numaralandırma düzeni (R=satiR / N=sütuN): ")) pts nil pvt nil Mtrx nil) (while (setq pt (getpoint "\n Select point")) (setq pts (append pts (list pt)))) (setq pts (mapcar '(lambda (xy) (list (car xy) (cadr xy))) pts) XLer (mapcar '(lambda (xx) (car xx)) pts) YLer (mapcar '(lambda (yy) (cadr yy)) pts) L (length Xler) n -1) (while (< (setq n (1+ n)) L) (setq pvt0 (nth n XLer) pvt (vl-remove pvt0 XLer) XLer (append (list pvt0) pvt) L (length XLer))) (setq L (length YLer) n -1) (while (< (setq n (1+ n)) L) (setq pvt0 (nth n YLer) pvt (vl-remove pvt0 YLer) YLer (append (list pvt0) pvt) L (length YLer))) (setq XLer (vl-sort XLer '<) YLer (vl-sort YLer '>) StnS (length XLer) StrS (length YLer) m -1) (cond ((= dzn "SATIR") (while (< (setq m (1+ m)) StrS) (setq n -1) (while (< (setq n (1+ n)) StnS) (setq Mtrx (append Mtrx (list (list (nth n XLer) (nth m YLer)))))))) ((= dzn "SUTUN") (while (< (setq m (1+ m)) StnS) (setq n -1) (while (< (setq n (1+ n)) StrS) (setq Mtrx (append Mtrx (list (list (nth m XLer) (nth n YLer))))))))) (setq L (length Mtrx) n -1) (while (< (setq n (1+ n)) L) (if (= (vl-position (nth n Mtrx) pts) nil) (setq Mtrx (vl-remove (nth n Mtrx) Mtrx) L (length Mtrx) n (1- n)))) (setq L (length Mtrx) n -1) (while (< (setq n (1+ n)) L) (entmake (list (cons 0 "TEXT") (cons 10 (nth n Mtrx)) (cons 40 TxH) (cons 11 (nth n Mtrx)) (cons 1 (itoa (+ num n))) (cons 50 0) (cons 72 4))) (setq bbx (textbox (entget (entlast))) ycap (/ (distance (car bbx) (cadr bbx)) 1.5)) (entmake (list (cons 0 "CIRCLE") (cons 10 (nth n Mtrx)) (cons 40 ycap)))) (setq enum (+ num n)) (prin1)) kolay gelsin... ProhibiT (22.03.2011 21:20 GMT) Beğenmek için anlamak lazım...

18.02.2011 20:22 62774	ibocompany Kıdemli Girişimci 23 ileti inşmüh ankara
Hocam kodda bi yerde bi problem var yada ben çözemedim. örnek kodda noktalara yaazı ve circle koyuyor sanırım ama yapmıyor. ben kareleri seçtirip yaptırayım dedim ama orjinal koddaki sorunu çözemediğim iiçin debelenip duruyorum çözmek için.

18.02.2011 22:18 62776	ProhibiT Yetkili 1612 ileti İnşaat Mühendisi Ankara
(initget 7 "satir sutun") satırında kırmızı renkli harfleri büyük harfle yazın. (cond ((= dzn "satır") satırında işaretli kısmı büyük harfle yazın. ((= dzn "sutun") satırında işaretli kısmı büyük harfle yazın. (entmake (list (cons 0 "text") (cons 10 (nth n mtrx)) satırında işaretli kısmı büyük harfle yazın. (entmake (list (cons 0 "cırcle") (cons 10 (nth n mtrx)) (cons 40 ycap)))) satırında işaretli kısmı büyük harfle yazın. bu değişiklikleri yaptığınızda problemsiz çalışacaktır. ya da, özel mesajla gönderdiğim kodu kullanın. kolay gelsin. Beğenmek için anlamak lazım...

23.02.2011 20:04 62928	ibocompany Kıdemli Girişimci 23 ileti inşmüh ankara
Hocam elemana numara verme işi tamam :) sırayla kolon numarası atıyor şimdi s101, s102 ... fantezimin ikinci aşamasına geçecem işlerim azalsında. kolon çizen lispi yaptım donatısını çiizyor ve yanına etriyesinide açıyor. boş vaktimde aynı kolonun görümüşünü yaptırıcam. fantazi kısmı ise bu numara verdirdiğim kolonları kullanarak her bi kolon için detay çizdiricem. aslında mantığı ve bağlantıyı kurduktan sonra çözümsüz değil. adınınıda ibocad koyarım artık :d tabi prohibit in katkılarıyla yazmakta lazım proğramın altına :)

22.03.2011 08:58 63475	ksk Yeni üye 1 ileti mak. müh. izmir
Bu kolona numara verme hangi komut ile başlıyor. bi söyleseniz çok makbule geçer. teşekkür mersiler herkeze

22.03.2011 09:55 63480	ProhibiT Yetkili 1612 ileti İnşaat Mühendisi Ankara
Bir yanlış anlama söz konusu herhalde... bir tek komuttan bahsediyor olsaydık, bunca uzun yazılara ne gerek vardı ki? bunca yazılanı özetleyip, "kolona numara verme" olarak okumuşsunuz. :) bu başlık altında tartışılan konu; satır veya kolon düzeninde numaralandırma algoritmasıdır. kolay gelsin. Beğenmek için anlamak lazım...

25.03.2011 10:05 63567	ibocompany Kıdemli Girişimci 23 ileti inşmüh ankara
Kod: (defun c:kolnum (/ Txh num dzn pts pvt pvt0 Mtrx XLer YLer StrS StnS bbx ycap L m n) (if (= eTxH nil) (setq eTxH (* (getvar "dimtxt") (getvar "dimscale")))) (setq TxH (getreal (strcat "\nYazi yuksekligi <" (rtos eTxH) "> :"))) (if (= TxH nil) (setq TxH eTxH) (setq eTxH TxH)) (if (= enum nil) (setq enum 1)) (setq num (getint (strcat "\nBaslangic sayisi <" (itoa enum) "> :"))) (if (= num nil) (setq num enum)) (initget 7 "satiR sutuN") (setq dzn (strcase (getkword "\Numaralandırma düzeni (R=satiR / N=sütuN): ")) pts nil pvt nil Mtrx nil) (setq myset (ssget (list(cons 0 "lwpolyline,circle"))) l (sslength myset) n -1) (while (< (setq n (1+ n)) l) (setq pt (cdr (assoc 10 (entget (ssname myset n)))) number_string (itoa (1+ n))) (setq pts (append pts (list pt)))) (setq pts (mapcar '(lambda (xy) (list (car xy) (cadr xy))) pts) XLer (mapcar '(lambda (xx) (car xx)) pts) YLer (mapcar '(lambda (yy) (cadr yy)) pts)) (setq L (length Xler) n -1) (while (< (setq n (1+ n)) L) (setq pvt0 (nth n XLer) pvt (vl-remove pvt0 XLer) XLer (append (list pvt0) pvt) L (length XLer))) (setq L (length YLer) n -1) (while (< (setq n (1+ n)) L) (setq pvt0 (nth n YLer) pvt (vl-remove pvt0 YLer) YLer (append (list pvt0) pvt) L (length YLer))) (setq XLer (vl-sort XLer '<) YLer (vl-sort YLer '>) StnS (length XLer) StrS (length YLer) m -1) (cond ((= dzn "SATIR") (while (< (setq m (1+ m)) StrS) (setq n -1) (while (< (setq n (1+ n)) StnS) (setq Mtrx (append Mtrx (list (list (nth n XLer) (nth m YLer)))))))) ((= dzn "SUTUN") (while (< (setq m (1+ m)) StnS) (setq n -1) (while (< (setq n (1+ n)) StrS) (setq Mtrx (append Mtrx (list (list (nth m XLer) (nth n YLer))))))))) (setq L (length Mtrx) n -1) (while (< (setq n (1+ n)) L) (if (= (vl-position (nth n Mtrx) pts) nil) (setq Mtrx (vl-remove (nth n Mtrx) Mtrx) L (length Mtrx) n (1- n)))) (setq L (length Mtrx) n -1) (while (< (setq n (1+ n)) L) (entmake (list (cons 0 "text") (cons 10 (nth n mtrx)) (cons 40 txh) (cons 11 (nth n mtrx)) (cons 1 (strcat "S" (itoa (+ num n)))) (cons 50 0) (cons 72 2)))) (setq enum (+ num n)) (prin1) )

> 1 <