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.

Önceki Sayfa [1] [2] [3] [4] [5] [6] [7] [8] [9] [10] [15] [20] [25] [30] [35] [40] [45] [50] [55] [60] [65] [70] [75] [80] [85] [90] [95] > 100 <
Copyright © 2004-2022 SQL: 0.88 saniye - Sorgu: 68 - Ortalama: 0.01294 saniye