Copyright © 2004-2022 SQL: 0.842 saniye - Sorgu: 75 - Ortalama: 0.01122 saniye
 |
 |
 |
 |
|
|
|
|
22.01.2024 15:35
brazor58 
|
|
Bunu saygısızlık olarak algılamanız yersiz ve gereksiz bi duyar. Bu platformda sizlerin ve diğer arkadaşların ne kadar bu işe zaman harcadığının farkındayım zaten. Eğer zor ve zaman alıcı birşeyse zaten yazmaz kimse. burada 10 sayfa lisp yazılmış ama buradanda paylaşılmış. Herhangi ücret talep edilmeden. Eğer ücret karşılığında yaptıracaksam zaten bununla ilgili internette birsürü firmaylada rahatlıkla iletişime geçebilirim. Burada bir yardım talebinde bulunmak size saygısızlık olarak algılanıyor. Zorsa yapmak istemiyorsa zaten kimse kimseye bişey diyemez. Altını tekrardan çiziyorum böyle insanlara saygısızlık etmişim gibi gereksiz cümleleri kabul etmiyorum.
|
|
23.01.2024 06:06
 ehya
|
|
brazor58
Öncelikle emeğe saygı gösterelim dedim. Ücret istenmesinin nedenini söyledim. Kişisel saygısızlıktan bahsetmiyorum. Böyle bir durum olsa zaten konu devam edemezdi. Ücretli yazdırmak isteseniz de birsürü dediğiniz firmalara (hangi firmalar çok merak ediyorum) gidip bi fiyat alın. Yapılan işlemin basit olması kodunun da kısa olması gerektiğiniz göstermez. Her lispten ücret alınacak diye birşey yok. Bu kişilerin tercihi. Paylaşır yada paylaşmaz. Eğer bir kazanç olacak ise bu karşılıklı olmalı. Ücretsiz lispler bu sitede ve birçok platformda var. Yükleyin ve kullanın. Ancak genele hitap etmeyen ve sırf bu istek için siteye yeni üye olup ilk mesajında lisp isteyen kişinin isteğinin ücret karşılığında olacağını öğrendiğinde gösterdiği tepki de bizim açımızdan hiç hoş değil. Kabul edersiniz yada etmezsiniz. Tercih sizin..
|
|
23.01.2024 07:31
brazor58
|
|
Daha fazla laf kalabalıklığı yapıp uzatmak istemiyorum gerek yok. Yanlış anlaşıldıysam kusura bakmayın iyi günler .
|
|
01.03.2024 08:30
bayrecep
|
|
İyi günler herkese. Şöyle bir lisp ihtiyacım var yardımcı olurmusunuz.
Çizimde yer alan block objeleri seçecek,seçtikten sonra patlatacak (explode) ve purge ile çizimi temizleyecek. Birçok çizim var tek tek uğraşmak ciddi zaman alıyor.
|
|
02.05.2024 09:50
semiyildiz
|
|
merhabalar ,
kullandığım bir lisp var, yazıları multileader etikete çeviriyor, yalnız sağa ve sola doğru yazıyı hizalıyor ,lispi çalıştırdıktan sonra çizginin ortasına tıklıyorum ve ok buraya yerleşiyor sonra dikey eksene göre sol tarafa tıklarsam yazıyı sola doğru yapıştırıyor ,sağ tarafa doğru tıklarsam sağa doğru yapıştırıyor, benim ricam yukarı ve aşağı yönlendirecek şekilde de tıklama seçeneği ekleyebilir miyiz ? birde komutu başlatmak için her seferinde tekrar girmem gerekiyor ,otomatik tekrarlama yapabilirsek çok iyi olur, kod şu şekilde; Kod: (defun c:am (/ newleader pt1 pt2 ss txt x w rjp-getbbwdth)
(vl-load-com) (defun rjp-getbbwdth (obj / out ll ur) (vla-getboundingbox obj 'll 'ur) (setq out (mapcar 'vlax-safearray->list (list ll ur))) (distance (car out) (list (caadr out) (cadar out))) ) (if (setq ss (ssget '((0 . "*TEXT")))) (progn (setq txt (apply 'strcat (mapcar 'cdr (vl-sort (mapcar '(lambda (x) (cons (vlax-get x 'insertionpoint) (strcat (vlax-get x 'textstring) " ") ) ) (setq ss (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) ) ) ) (function (lambda (y1 y2) (< (cadr (car y2)) (cadr (car y1)))) ) ) ) ) w (car (vl-sort (mapcar 'rjp-getbbwdth ss) '>)) txt (apply 'strcat (mapcar 'chr (reverse (cdr (reverse (vl-string->list txt))))) ) ) (mapcar 'vla-delete ss) ) ) (if (and (setq pt1 (getpoint "nSpecify leader arrowhead location: ")) (setq pt2 (getpoint pt1 "nSpecify landing location: ")) ) (progn (command "._MLEADER" pt1 pt2 "") (setq newleader (vlax-ename->vla-object (entlast))) (vla-put-textstring newleader txt) (vla-put-textwidth newleader w) ) ) (princ) ) ProhibiT (02.05.2024 10:05 GMT) |
|
02.05.2024 12:40
ufuk1245
|
|
Merhabalar,
2019 Autocadda çalışan lsp dosyası aşağıdaki detay yani 2025 autocadde çalışmıyor neden olabilir bu sorun bilgi verebilirseniz çok sevinirim teşekkürler, (defun C:BoMe(/ Boy Cap cp gbr Kbr KPNo kuk L MPo myerr Nk1 Nk2 olderr Rw YYuk) (defun myerr (errmsg) (if (/= errmsg "\nFunction cancelled") (prompt (strcat "\n" errmsg))) (command "._undo" "_e") (mapcar 'vlax-release-object (list rn ExCLLs Sht1 Shts NwBook Books ExApp)) (setq ExApp nil) (gc) (gc) (setq egbr gbr eKbr Kbr eYuk YYuk eKPN KPNo) (setq *error* olderr) (princ)) (setq olderr *error* *error* myerr) (*push-error-using-command*) (setvar "cmdecho" 0) (command "undo" "group") (vl-load-com) (setq cp "") (foreach ch '(77 46 32 83 97 104 105 110 32 71 252 118 101 114 99 105 110 32 45 32) (setq cp (strcat cp (chr ch)))) (if (not egbr) (setq egbr "Cm")) (setq kuk (initget "Mm Cm mT """) gbr (getkword (strcat "\nÇizim Birimi [Mm/Cm/mT] <" egbr "> :"))) (if (not gbr) (setq gbr egbr)) (if (not eKbr) (setq eKbr "Mm")) (if (not eYuk) (setq eYuk (* (getvar "dimtxt") (getvar "dimscale")))) (setq kuk (initget) YYuk (getreal (strcat "\nYazi yüksekligi <" (rtos eYuk) "> :"))) (if (not YYuk) (setq YYuk eYuk)) (if (not eKPN) (setq eKPN 1)) (setq KPNo (getint (strcat "\nPoz Numarası <" (itoa eKPN) "> :"))) (if (not KPNo) (setq KPNo eKPN)) (setq ExApp (vlax-get-or-create-object "Excel.Application") Rw 1) (if (setq NwBook (vlax-get-property ExApp "ActiveWorkbook")) (setq Books (vlax-get-property ExApp "WorkBooks") Shts (vlax-get-property NwBook "Sheets") Sht1 (vlax-invoke-method Shts "Add")) (setq Books (vlax-get-property ExApp "WorkBooks") NwBook (vlax-invoke-method Books "Add") Shts (vlax-get-property NwBook "Sheets") Sht1 (vlax-get-property Shts "Item" 1))) (setq ExCLLs (vlax-get-property Sht1 "Cells")) (vlax-put-property ExApp "UseSystemSeparators" :vlax-false) (vlax-put-property ExApp "DecimalSeparator" ".") (vla-put-visible ExApp :vlax-true) (mapcar '(lambda (p1 p2) (vlax-put-property ExCLLs 'Item (nth 0 p1) (nth 1 p1) p2)) '((1 1 1 1) (1 2 1 2) (1 3 1 3)) '("Poz No." "Çap" "Boy")) (vlax-put-property (vlax-get-property (vlax-get-property ExCLLs "Range" (vlax-variant-value (vlax-get-property ExCLLs 'Item 1 1)) (vlax-variant-value (vlax-get-property ExCLLs 'Item 1 3))) 'CeLLs) 'HorizontalAlignment (vlax-make-variant -4108)) (while (setq Nk1 (getpoint "\nBoru Başlangıç Noktasını seçiniz...")) (setq Nk2 (getpoint Nk1 "\n Boru Bitiş Noktasını seçiniz...") Boy (distance Nk1 Nk2) MPo (mapcar '(lambda (n1 n2) (/ (+ n1 n2) 2.0)) Nk1 Nk2)) (entmake (list (cons 0 "TEXT") (cons 10 MPo) (cons 40 YYuk) (cons 1 (itoa KPNo)) (cons 50 0) (cons 72 4) (cons 11 MPo))) (entmake (list (cons 0 "CIRCLE") (cons 10 MPo) (cons 40 (* 1.15 YYuk)))) (princ "\nBoru Çap Yazısını seçiniz...") (while (not (setq Cap (ssget "+.:s" (list (cons 0 "*TEXT"))))) (princ "\n Sectiginiz obje bir Text veya MText olmalıdır!")) (cond ((= gbr "Mm") (setq Boy (/ Boy 1000))) ((= gbr "Cm") (setq Boy (/ Boy 100))) ((= gbr "m") (setq Boy Boy)) (T nil)) (setq Rw (1+ Rw) Cap (cdr (assoc 1 (entget (ssname Cap 0))))) (if (vl-string-position 45 Cap) (setq Cap (substr Cap (+ 2 (vl-string-position 45 Cap))))) (mapcar '(lambda (p1 p2) (vlax-put-property ExCLLs 'Item rw p1 p2)) '(1 2 3) (list (itoa KPNo) Cap (rtos Boy 2 2))) (princ (strcat "\n* Poz No:" (itoa KPNo) ", Çap:" Cap ", Boy:" (rtos Boy 2 2))) (setq KPNo (1+ KPNo))) (setq Rw (1+ Rw) rn (vlax-get-property ExCLLs "Range" (vlax-variant-value (vlax-get-property ExCLLs 'Item Rw 1)) (vlax-variant-value (vlax-get-property ExCLLs 'Item Rw 3)))) (vlax-put-property rn 'MergeCells :vlax-true) (vlax-put-property ExCLLs 'Item Rw 1 (foreach ch '(119 119 119 46 99 105 122 105 109 111 107 117 108 117 46 99 111 109) (setq cp (strcat cp (chr ch))))) (vlax-put-property rn 'ShrinkToFit :vlax-true) (setq rn (vlax-get-property ExCLLs "Range" (vlax-variant-value (vlax-get-property ExCLLs 'Item 1 1)) (vlax-variant-value (vlax-get-property ExCLLs 'Item Rw 3)))) (vlax-put-property (vlax-get-property rn 'Borders) 'color (vlax-make-variant "0.0")) (vlax-put-property (vlax-get-property rn 'Borders) 'LineStyle (vlax-make-variant "1")) (vlax-invoke-method (vlax-get-property rn 'Columns) 'AutoFit) (vlax-invoke-method (vlax-get-property rn 'Rows) 'AutoFit) (vlax-put-property ExApp "UseSystemSeparators" :vlax-true) (mapcar 'vlax-release-object (list rn ExCLLs Sht1 Shts NwBook Books ExApp)) (setq ExApp nil) (gc) (gc) (setq egbr gbr eKbr Kbr eYuk YYuk eKPN KPNo) (command "_.undo" "end") (setq *error* olderr) (*pop-error-mode*) (prin1))
|
|
09.05.2024 04:48
 alisezgin
|
|
Şeflerim merhaba ,
Ben elektrik mühendisiyim , işlerimizde linye iptalleri veya ilaveleri oluyor . Bu konu ile alakalı bir lisp isteğim olacak aradım bulamadım. Konusu textlerin içerisindeki sayısal değerden 1 ekleyecek veya 1 çıkaracak . yardımcı olursanız sevinirim saygılarımla. örnek resim; Linkleri görebilmek için ÜYE olmalısınız.
|
|
09.05.2024 08:50
ehya
|
Alıntı Çıkarma işlemi için kod aşağıdadır.. (itoa (- (atoi kısmındaki - işaretini + yaparsanız toplama işlemi yapar. Buna göre lispi çoğaltabilirsiniz. Kod: (defun c:NE (/ ss tek acss )
(if (setq ss (ssget (list (cons 0 "TEXT")))) (progn (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-StartUndomark doc) (vlax-for tek (setq acss (vla-get-ActiveSelectionSet doc)) (vla-put-textstring tek (strcat (substr (vla-get-textstring tek) 1 1) (itoa (- (atoi (substr (vla-get-textstring tek) 2))1)) ))) (vla-endUndomark doc) )) (princ))
|
|
10.05.2024 11:43
ufuk1245
|
|
Hocam rahatsız ediyorum kusura bakmayın lütfen daha önce 2013 autocadde çalışan LSP dosyaları vardı bende kullanabiliyordum ancak şuan 2024 veya başka hiçbir autocadde VL OBJECT NİL hatası veriyor lsp yazılımı şu şekilde; Sorunu nasıl çözebilirim acaba yardımcı olabilirseniz sevinirim Teşekkürler,
(defun C:KaMe (/ Ayrc b bhb Books Boy cp Ebat ExApp ExCLLs gbr h Kbr KPNo kuk L MPo myerr n1 n2 Nk1 Nk2 NwBook olderr p1 p2 rn Rw Sht1 Shts SLn Thc Yer YYer YYuk) (setvar "cmdecho" 0) (command "undo" "group") (vl-load-com) (defun myerr (errmsg) (if (/= errmsg "nFunction cancelled") (prompt (strcat "n" errmsg))) (command-s "._undo" "_e") (setq error olderr) (princ)) (setq olderr error error myerr) (setq cp "") (foreach ch '(77 46 32 83 97 104 105 110 32 71 252 118 101 114 99 105 110 32 45 32) (setq cp (strcat cp (chr ch)))) (if (not egbr) (setq egbr "Cm")) (setq kuk (initget "Mm Cm mT """) gbr (getkword (strcat "nÇizim Birimi [Mm/Cm/mT] <" egbr "> :"))) (if (not gbr) (setq gbr egbr)) (if (not eKbr) (setq eKbr "Mm")) (setq kuk (initget "Mm Cm mT """) Kbr (getkword (strcat "nKanal Ebadı Birimi [Mm/Cm/mT] <" eKbr "> :"))) (if (not Kbr) (setq Kbr eKbr)) (if (not eYuk) (setq eYuk (* (getvar "dimtxt") (getvar "dimscale")))) (setq kuk (initget) YYuk (getreal (strcat "nYazi yüksekligi <" (rtos eYuk) "> :"))) (if (not YYuk) (setq YYuk eYuk)) (if (not eKPN) (setq eKPN 1)) (setq KPNo (getint (strcat "nKanal Poz Numarası <" (itoa eKPN) "> :"))) (if (not KPNo) (setq KPNo eKPN)) (setq ExApp (vlax-get-or-create-object "Excel.Application") Rw 2) (if (setq NwBook (vlax-get-property ExApp "ActiveWorkbook")) (setq Books (vlax-get-property ExApp "WorkBooks") Shts (vlax-get-property NwBook "Sheets") Sht1 (vlax-invoke-method Shts "Add")) (setq Books (vlax-get-property ExApp "WorkBooks") NwBook (vlax-invoke-method Books "Add") Shts (vlax-get-property NwBook "Sheets") Sht1 (vlax-get-property Shts "Item" 1))) (setq ExCLLs (vlax-get-property Sht1 "Cells")) (vlax-put-property ExApp "UseSystemSeparators" :vlax-false) (vlax-put-property ExApp "DecimalSeparator" ".") (vla-put-visible ExApp :vlax-true) (mapcar '(lambda (p1 p2) (vlax-put-property (vlax-get-property ExCLLs "Range" (vlax-variant-value (vlax-get-property ExCLLs 'Item (nth 0 p1) (nth 1 p1))) (vlax-variant-value (vlax-get-property ExCLLs 'Item (nth 2 p1) (nth 3 p1)))) 'MergeCells :vlax-true) (vlax-put-property ExCLLs 'Item (nth 0 p1) (nth 1 p1) p2)) '((1 1 2 1) (1 2 1 3) (2 2 2 2) (2 3 2 3) (1 4 2 4) (1 5 2 5) (1 6 2 6)) (list "Poz No." "Kanal Ebadı" (strcat "Genişlikn(" (strcase Kbr T) ")") (strcat "Yükseklikn(" (strcase Kbr T) ")") "Kanal Boyun(m)" "Alann(m²)" "Sac Kalınlığın(mm)")) (vlax-put-property (vlax-get-property (vlax-get-property ExCLLs "Range" (vlax-variant-value (vlax-get-property ExCLLs 'Item 1 1)) (vlax-variant-value (vlax-get-property ExCLLs 'Item 2 6))) 'CeLLs) 'HorizontalAlignment (vlax-make-variant -4108)) (while (setq Nk1 (getpoint "nKanal Başlangıç Noktasını seçiniz...")) (setq Nk2 (getpoint Nk1 "n Kanal Bitiş Noktasını seçiniz...") Boy (distance Nk1 Nk2) MPo (mapcar '(lambda (n1 n2) (/ (+ n1 n2) 2.0)) Nk1 Nk2)) (entmake (list (cons 0 "TEXT") (cons 10 MPo) (cons 40 YYuk) (cons 1 (itoa KPNo)) (cons 50 0) (cons 72 4) (cons 11 MPo))) (entmake (list (cons 0 "CIRCLE") (cons 10 MPo) (cons 40 (* 1.15 YYuk)))) (if (= Ebat0 nil) (setq Ebat0 "200*400")) (setq Ebat (getstring (strcat "nKanal Ebadını Giriniz <" Ebat0 ">: "))) (if (= Ebat "") (setq Ebat Ebat0) (setq Ebat0 Ebat)) (setq Ayrc nil Ebat (if (or (wcmatch Ebat "Ø*") (wcmatch Ebat "ø*")) (substr Ebat 2) (if (wcmatch Ebat "%%C*") (substr Ebat 4) Ebat)) L (strlen Ebat)) (while (> (setq L (1- L)) 0) (if (or (< (ascii (substr Ebat L 1)) 48)(> (ascii (substr Ebat L 1)) 57)) (setq Ayrc (ascii (substr Ebat L 1))))) (if Ayrc (setq yer (vl-string-position Ayrc Ebat) b (atof (substr Ebat 1 yer)) h (atof (substr Ebat (+ yer 2))) bhb (if (> b h) b h)) (setq b (atof Ebat) h 0 bhb b)) (cond ((= Kbr "Mm") (setq b (/ b 1000) h (/ h 1000))) ((= Kbr "Cm") (setq b (/ b 100) h (/ h 100) bhb (* bhb 10))) ((= Kbr "mT") (setq b b h h bhb (* bhb 1000))) (T nil)) (cond ((= gbr "Mm") (setq Boy (/ Boy 1000))) ((= gbr "Cm") (setq Boy (/ Boy 100))) (T nil)) (setq Thc (cond ((<= bhb 249) 0.5) ((and (> bhb 249) (<= bhb 499)) 0.6) ((and (> bhb 499) (<= bhb 989)) 0.75) ((and (> bhb 989) (<= bhb 1989)) 0.90) ((and (> bhb 1989) (<= bhb 2489)) 1.15) ((>= bhb 2490) 1.2)) SLn (if (zerop h) (* pi b Boy) (* (* (+ b h) 2.0) Boy)) Rw (1+ Rw)) (cond ((= Kbr "Mm") (setq b (* b 1000) h (* h 1000))) ((= Kbr "Cm") (setq b (* b 100) h (* h 100)))) (if (zerop h) (setq b (strcat "Ø" (rtos b)) h "-")) (mapcar '(lambda (p1 p2) (vlax-put-property ExCLLs 'Item rw p1 p2)) '(1 2 3 4 5 6) (list (itoa KPNo) (if (= (type b) 'STR) b (rtos b)) (if (= (type h) 'STR) h (rtos h)) (rtos Boy 2 2) (rtos SLn 2 2) (rtos Thc 2 2))) (princ (strcat "n* Poz No:" (itoa KPNo) ", Kanal Ebadı:" (if (= h "-") (strcat "Ø" Ebat) Ebat) ", Kanal Uzunluğu:" (rtos Boy 2 2) ", Sac Alanı:" (rtos SLn 2 2) ", Sac Kalınlığı:" (rtos Thc))) (setq KPNo (1+ KPNo))) (setq Rw (1+ Rw) rn (vlax-get-property ExCLLs "Range" (vlax-variant-value (vlax-get-property ExCLLs 'Item Rw 1)) (vlax-variant-value (vlax-get-property ExCLLs 'Item Rw 6)))) (vlax-put-property rn 'MergeCells :vlax-true) (vlax-put-property ExCLLs 'Item Rw 1 (foreach ch '(119 119 119 46 99 105 122 105 109 111 107 117 108 117 46 99 111 109) (setq cp (strcat cp (chr ch))))) (vlax-put-property rn 'ShrinkToFit :vlax-true) (setq rn (vlax-get-property ExCLLs "Range" (vlax-variant-value (vlax-get-property ExCLLs 'Item 1 1)) (vlax-variant-value (vlax-get-property ExCLLs 'Item Rw 6)))) (vlax-put-property (vlax-get-property rn 'Borders) 'color (vlax-make-variant "0.0")) (vlax-put-property (vlax-get-property rn 'Borders) 'LineStyle (vlax-make-variant "1")) (vlax-invoke-method (vlax-get-property rn 'Columns) 'AutoFit) (vlax-invoke-method (vlax-get-property rn 'Rows) 'AutoFit) (vlax-put-property ExApp "UseSystemSeparators" :vlax-true) (mapcar 'vlax-release-object (list rn ExCLLs Sht1 Shts NwBook Books ExApp)) (setq ExApp nil) (gc) (gc) (setq egbr gbr eKbr Kbr eYuk YYuk eKPN KPNo) (command "_.undo" "end") (setq error olderr) (prin1))
|
|
mesuttasar
|
Alıntı Merhaba, polyline veya line üzerine istenilen mesafede km yazan lisp kodu aşağıdadır. Kod: (defun c:ky(/ eks eksdata plset mes obj lenobj dgr km mes angle1 pt1 pt2)
(setq eks (car (entsel "\n Ekseni seciniz..:"))) (setq eksdata (entget eks)) (setq mes (getint "\nAra mesafeyi giriniz..:")) (vl-load-com) (setq obj (vlax-ename->vla-object eks)) (setq lenobj (vlax-get-property obj 'length)) (setq dgr 0) (setq km 0) (while (> lenobj km) (setq km (+ dgr mes)) (setq pt (vlax-curve-getpointAtDist obj km)) (setq pt1 (vlax-curve-getpointAtDist obj (- km 0.01))) ;Bir önceki nokta (setq pt2 (vlax-curve-getpointAtDist obj (+ km 0.01))) ;Bir sonraki nokta (setq angle1 (angle pt1 pt2)) ;İki nokta arasındaki açiyi hesapla (setq angle1 (+ angle1 (/ pi 2.0))) (entmake (list (cons 0 "text") (cons 10 pt) (cons 40 1) (cons 1 (itoa km)) (cons 50 angle1))) (entmake (list (cons 0 "point") (cons 10 pt) (cons 8 "0"))) (setq dgr km) );while );end mesuttasar (11.05.2024 09:24 GMT) |