Copyright © 2004-2022 SQL: 1.11 saniye - Sorgu: 61 - Ortalama: 0.0182 saniye
 |
 |
 |
 |
|
|
|
|
11.01.2024 09:16
 akcan
|
|
Her tıklamada sırasıyla bir harf yazan autolisp kodlarını acemice yazdım.
Kodlar çalışıyor sorun yok gibi. Hata kontrol kodları eklemedim. İsteğim; aşağıdaki işlevi yerine getiren kodların eklenmesi ve düzenlenmesi. Yazı konumunu belirtmeden önce yerleştirilecek harfin fare imlecinde gösterilmesi (COPY komutundaki gibi) tıklandığında fare konumuna harfin eklenmesi. Kod: ; Her tıklamada sırasıyla bir harf yaz
; Mesut Akcan 11//01/2024 (defun c:HY (/ yy ei bitis konum) (setq yy 5) ;yazı yüksekliği (if i (setq ei i) ;önceki i değeri (setq i 65) ;ilk defa çalışıyorsa i 65 ) (setq i (ascii (getstring (strcat "\nİlk harf:<" (chr i) ">")))) (if (= i 0) ; enter ile geçildiyse (if ei (setq i ei)(setq i 65)) ;önceki i varsa i=önceki i, yoksa i=65 ) (cond ((and (>= i 65) (<= i 90)) (setq bitis 90)) ;i=65-90 ise bitiş 90 ((and (>= i 97) (<= i 122)) (setq bitis 122)) ;i=97-122 ise bitiş 122 (t (princ "\nGeçersiz bir harf girildi!")(setq i 65)(exit)) ) (while (<= i bitis) ; i bitiş'den küçük eşitse ;yazı yazılacak konum (setq konum (trans (getpoint "\nHarf yazılacak konumu belirtin: ") 1 0)) (entmake ;yazı nesnesi oluştur (list ;Liste yap (cons 0 "TEXT") ;Listenin 0 elemanı = "TEXT" (cons 8 "YAZI") ;Katman (cons 1 (strcat (chr i))) ;sıra numarası yazısı. a,b,c A,B,C (cons 10 konum) ; ekleme noktası1 (cons 11 konum) ; ekleme noktası2 (cons 40 yy) ; yazı yüksekliği ;(cons 72 1) ; yaslama1 ;(cons 73 2) ; yaslama2 ) ) (setq i (1+ i)) ;i'yi bir arttır ) ;son harfi geçtiyse ilk harfe dön (if (> i bitis)(setq i (- bitis 25))) (princ) )
|
|
11.01.2024 13:42
 alumina
|
Alıntı Mesut Bey, Mevcut kodlar uzerinden duzenleme yapmak hem zor hemde hataya acik bir durum oldugu icin bende acemice bir seyler yazmaya calistim.. Isinizi gorur sanirim.. Kod: (defun c:qs (/ dc tx ts rx tz n0)
(vl-load-com) (if (and (setq dc (vla-get-ActiveDocument (vlax-get-acad-object))) (/= (setq tx (getstring T "\nEnter the text string:")) "")) (if (and (= (strlen tx) 1) (or (<= 65 (setq ts (ascii tx)) 90) (<= 97 ts 122))) (progn (setq ts (1- ts) rx '(0. 0. 0.)) (vla-StartUndomark dc) (while (setq ts (1+ ts) ts (cond ((= ts 91) 97) ((= ts 123) 65) (ts)) tz (vlax-ename->vla-object (entmakex (list '(0 . "Text") (cons 1 (chr ts)) '(8 . "Katman") (cons 10 rx) (cons 11 rx) '(40 . 5) '(71 . 0) '(72 . 1) '(73 . 2))))) (while (/= 3 (car (setq n0 (grread T 1 0)))) (setq n0 (cadr n0)) (vla-TransformBy tz (vlax-tmatrix (list (list 1 0 0 (- (car n0) (car rx))) (list 0 1 0 (- (cadr n0) (cadr rx))) '(0 0 1 0) '(0 0 0 1)))) (setq rx n0) ) ) (vla-EndUndomark dc) ) ) ) (prin1) )
|
|
11.01.2024 14:36
akcan
|
|
kodlar için teşekkürler alumina
işimi görüyor. verdiğiniz kodlar acemilikten öte olduğu için benim kodlara adapte edemedim. sizin kodlarda tek sorun ESC ya da Enter ya da sağ tıklama ile işlem tamamlandığında son harfi de yazıyor
|
|
alumina
|
Alıntı Cikis yaptiginizda son nesneyi silecek sekilde duzenledim.. Kod: (defun c:qw (/ dc tx ts rx tz n0)
(vl-load-com) (defun ert (/) (defun *error* (msg) (if (not (wcmatch msg "*Function cancelled*,*bad argument type*")) (princ (strcat "\nError: " msg))) (entdel (entlast)) ) ) (ert) (if (and (setq dc (vla-get-ActiveDocument (vlax-get-acad-object))) (/= (setq tx (getstring T "\nEnter the text string:")) "")) (if (and (= (strlen tx) 1) (or (<= 65 (setq ts (ascii tx)) 90) (<= 97 ts 122))) (progn (setq ts (1- ts) rx '(0. 0. 0.)) (vla-StartUndomark dc) (while (setq ts (1+ ts) ts (cond ((= ts 91) 97) ((= ts 123) 65) (ts)) tz (vlax-ename->vla-object (entmakex (list '(0 . "Text") (cons 1 (chr ts)) '(8 . "Katman") (cons 10 rx) (cons 11 rx) '(40 . 5) '(71 . 0) '(72 . 1) '(73 . 2))))) (while (/= 3 (car (setq n0 (grread T 1 0)))) (setq n0 (cadr n0)) (vla-TransformBy tz (vlax-tmatrix (list (list 1 0 0 (- (car n0) (car rx))) (list 0 1 0 (- (cadr n0) (cadr rx))) '(0 0 1 0) '(0 0 0 1)))) (setq rx n0) ) ) (vla-EndUndomark dc) ) ) ) (prin1) )
|