OHA LİSP | Forumlar - Çizim Okulu

Forum Menüsü

AutoCAD Genel

AutoCAD Eğitimi

3ds Max

Ziyaretçi: 649, Üye: 4
0xik, bcan38, macros55, sefa-er

Detaylar »

Forumlar > AutoLISP > OHA LİSP

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

İleti	Yazar
04.09.2014 13:13 78513	dgnmus Girişimci 5 ileti mühendis istanbul
İYİ GÜNLER METRAJ ÇIKARTIRKEN POZLARI SAYIP EXCEL ATMASI GEREKIYOR FAKAT OLMUYOR..AŞAĞİDAKİ HATAYI ALIYORUM. YARDIMCI OLAKLARA ÇOK BÜYÜK HAYIR DUASI ALIR..:):) sure that: • The name that you type does not exceed 31 characters. • The name does not contain any of the following characters: : \ / ? * [ or ] • You did not leave the name blank. Command: Kod: (vl-load-com) (defun mip-conv-to-str (dat)(if dat (vl-princ-to-string dat) "")) (defun get-all-atts (obj) (if (and obj (eq :vlax-true (vla-get-HasAttributes obj)) (vlax-property-available-p obj 'Hasattributes)) (vl-catch-all-apply (function (lambda() (mapcar (function (lambda (x) (cons (vla-get-TagString x) (vla-get-TextString x)))) (append (vlax-invoke obj 'Getattributes) (vlax-invoke obj 'Getconstantattributes) ))))))) ;\|================== XLS ======================================== * Purpose: Export of the list of data punto_datos in Excell * It is exported to a new leaf of the current book. If the book is not present, it is created * Arguments: punto_datos - The list of lists of data (LIST) ((Value1 Value2 ... VlalueN)(Value1 Value2 ... VlalueN)...) Each list of a kind (Value1 Value2... VlalueN) enters the name in a separate line in corresponding columns (Value1-A Value2-B and .ò.ä.) header - The list (LIST) headings or nil a kind (" Signature A " " Signature B "...) If header nil, is accepted ("X" "Y" "Z") Colhide - The list of alphabetic names of columns to hide or nil - to not hide ("A" "C" "D") - to hide columns A, C, D Name_list - The name of a new leaf of the active book or nil - is not present * Return: nil * Usage (xls '((1.1 1.2 1.3 1.4)(2.1 2.2 2.3 2.4)(3.1 3.2 3.3 3.4)) '("Col1" "Col2" "Col3" "Col4") '("B") "test") \|; (vl-load-com) (defun xls ( punto_datos header Colhide Name_list / aplexcel books-colection Currsep excell-cells new-book sheet#1 sheet-collection col iz_listo row cell cols) (defun Letter (N / Res TMP)(setq Res "")(while (> N 0)(setq TMP (rem N 26) TMP (if (zerop TMP)(setq N (1- N) TMP 26) TMP) Res (strcat (chr (+ 64 TMP)) Res) N (/ N 26))) Res) (if (null Name_list)(setq Name_list "")) (setq AplExcel (vlax-get-or-create-object "Excel.Application")) (if (setq New-Book (vlax-get-property AplExcel "ActiveWorkbook")) (setq Books-Colection (vlax-get-property AplExcel "Workbooks") Sheet-Collection (vlax-get-property New-Book "Sheets") Sheet#1 (vlax-invoke-method Sheet-Collection "Add")) (setq Books-Colection (vlax-get-property AplExcel "Workbooks") New-Book (vlax-invoke-method Books-Colection "Add") Sheet-Collection (vlax-get-property New-Book "Sheets") Sheet#1 (vlax-get-property Sheet-Collection "Item" 1))) (setq excell-cells (vlax-get-property Sheet#1 "Cells")) (setq Name_list (if (= Name_list "") (vl-filename-base(getvar "DWGNAME")) (strcat (vl-filename-base(getvar "DWGNAME")) "&" Name_list)) col 0 cols nil) (vlax-for sh Sheet-Collection (setq cols (cons (strcase(vlax-get-property sh 'Name)) cols))) (setq row Name_list) (while (member (strcase row) cols)(setq row (strcat Name_list " (" (itoa(setq col (1+ col)))")"))) (setq Name_list row) (vlax-put-property Sheet#1 'Name Name_list) (setq Currsep (vlax-get-property AplExcel "UseSystemSeparators")) (vlax-put-property AplExcel "UseSystemSeparators" :vlax-false) ;_êå èñïîëüçîâêòü ñèñòåìêûå óñòêêîâêè (vlax-put-property AplExcel "DecimalSeparator" ".") ;_?êçäåëèòåëü ä?îáêîé è öåëîé ÷êñòè (vlax-put-property AplExcel "ThousandsSeparator" " ") ;_?êçäåëèòåëü òûñÿ÷åé (vla-put-visible AplExcel :vlax-true)(setq row 1 col 1) (if (null header)(setq header '("X" "Y" "Z"))) (repeat (length header)(vlax-put-property excell-cells "Item" row col (vl-princ-to-string (nth (1- col) header)))(setq col (1+ col)))(setq row 2 col 1) (repeat (length punto_datos)(setq iz_listo (car punto_datos))(repeat (length iz_listo) (vlax-put-property excell-cells "Item" row col (vl-princ-to-string (car iz_listo))) (setq iz_listo (cdr iz_listo) col (1+ col)))(setq punto_datos (cdr punto_datos))(setq col 1 row (1+ row))) (setq col (1+(length header)) row (1+ row)) (setq cell (vlax-variant-value (vlax-invoke-method Sheet#1 "Evaluate" (strcat "A1:" (letter col)(itoa row))))) ;_ end of setq (setq cols (vlax-get-property cell 'Columns)) (vlax-invoke-method cols 'Autofit) (vlax-release-object cols)(vlax-release-object cell) (foreach item ColHide (if (numberp item)(setq item (letter item))) (setq cell (vlax-variant-value (vlax-invoke-method Sheet#1 "Evaluate" (strcat item "1:" item "1")))) (setq cols (vlax-get-property cell 'Columns)) (vlax-put-property cols 'hidden 1) (vlax-release-object cols)(vlax-release-object cell)) (vlax-put-property AplExcel "UseSystemSeparators" Currsep) (mapcar 'vlax-release-object (list excell-cells Sheet#1 Sheet-Collection New-Book Books-Colection AplExcel))(setq AplExcel nil)(gc)(gc)(princ)) (defun C:oha ( / blk pat head ss datalist att_list) (princ "\nChoose a block") (while (not(setq ss (ssget "_+.:S:E" '((0 . "INSERT")(66 . 1))))) (princ "\nWrong... Choose a block with attributes")) (setq blk (ssname ss 0) ss nil) (setq pat (vl-remove-if-not '(lambda(x)(member (car x) '(0 2 410)))(entget blk))) (setq head nil datalist nil) (if (setq ss (ssget "_X" pat)) (progn (foreach item (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) (setq att_list (get-all-atts item)) (if (null head)(setq head (mapcar 'car att_list))) (setq datalist (append datalist (list (mapcar 'cdr att_list)))) ) (xls datalist head nil nil) ) ) (princ) ) ;\|=============== Comand AREAS ================================================ Send the Layer, the area, length, color, a hyperlink in corresponding columns Excel. See also _HYPERLINKOPTIONS \|; (defun c:AREAS (/ selset error retLst lst i UrlDes are) (defun error (msg)(princ msg)(princ)) ;_ end of defun (vl-load-com) (if (setq selset (ssget '((0 . "POLYLINE"))))(progn (setq i 1) (foreach item (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))) (if(not (zerop(vla-get-Count (vla-get-Hyperlinks item)))) (VL-CATCH-ALL-APPLY '(lambda()(setq UrlDes(vla-get-URLDescription(vla-item (vla-get-Hyperlinks item) 0))))) (setq UrlDes "")) (setq lst (list (strcat "'" (vla-get-layer item)) ;\|Layer"\|; (rtos(setq are(vla-get-area item)) 2 12) ;\|Area\|; (rtos(vla-get-Length item) 2 12) ;\|Length\|; (vla-get-color item) ;\|Color\|; (if (= UrlDes "") "" (strcat "'" UrlDes)) ;\|Hyperlink\|; )) (setq retLst (append retLst (list lst))));_foreach (xls retlst '("Layer" "Area" "Length" "Color" "Hyperlink") nil "from AREAS"))) (princ)) ProhibiT (05.09.2014 04:48 GMT)*

04.09.2014 13:19 78514	Travaci Editör 2392 ileti Teknik Ressam Konstantinopol
Denedim bir hata vermedi.

04.09.2014 14:49 78515	dgnmus Girişimci 5 ileti mühendis istanbul
bende excel dosyası gelmıyor ..yukarda belırtığim hatayı veriyor. pc kapatırken excel açılmış gıbı kapatmaya zorluyor..ama masaüstüne kesinlikle gelmıyor.. ayrıca kanal metrakı hesaplarken çok iyi exceli açıyor..anlamadım ??

04.09.2014 15:43 78516	waytooraider Kıdemli Uzman 162 ileti makine mühendisi istanbul
Autocad dosyanını ismi uzun olduğu için excel sheeti kabul etmiyor. Dosya ismini kısaltmayı deneyebilirsin.

05.09.2014 06:07 78517	Travaci Editör 2392 ileti Teknik Ressam Konstantinopol
Dosya ismin 31 karakterden fazla olması ve \ / ? * [ gibi karakterlerin kullanılmasından dolayı.

05.09.2014 11:21 78518	kesinhesapci Kıdemli Girişimci 38 ileti teknik ofis şefi konstantin
bu lispi ne tür metrajlar çıkartırken kullanıyorsunuz...(belki kullanmak isteyen arkadaşlar ola bilir.): )

09.09.2014 06:40 78541	alirizasahin Kıdemli Uzman 118 ileti Makina Mühendisi
Arkadaşlar bu lisp'in nasıl çalıştığı ile ilgili bilgi veren olursa sevineceğim.Hangi metraj çıkarmada yardımcı oluyor?

13.09.2014 08:14 78576	kesinhesapci Kıdemli Girişimci 38 ileti teknik ofis şefi konstantin
Anlaşılan kimse bu lispi kullan mıyor ..

05.02.2015 10:18 80325	alpayelmas Kıdemli Uzman 121 ileti İnşaat Mühendisi İstanbul
Travaci Hocam :) bende asağıdaki gibi bir lisp yazdım. Verdiğin bilgiler sayesinde baya ilerleme kaydettiğimi düşünüyorum. Demir metrajı yapıcak arkadaşlarıma şimdiden faydalı olmasını dilerim. Eklediğim lispte hatalar veya ilaveler isteyenlerin bu başlık altından yazmasını rica ederim. Döşemelerde Demir Metrajı Kod: (vl-load-com) (defun c:demd (/ LM:GetAttributeValue ss attValue) (defun LM:GetAttributeValue (blk tag / val enx) (while (and (null val) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget (setq blk (entnext blk)))))) ) ) (if (= (strcase tag) (strcase (cdr (assoc 2 enx)))) (setq val (cdr (assoc 1 enx))) ) ) ) (setq dosad (strcat (getvar "dwgprefix") (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4 )) )) (setq tk (open (getfiled "" dosad "xls" 9) "w")) (setq j -1) (write-line (strcat "Poz Numarasi" "\t" "Demir Capi" "\t" "Demir Adedi" "\t" "Benzer Adedi" "\t" "Demir Boyu" "\t" "Demir Tipi" "\t" "1. Boy" "\t" "2. Boy" "\t" "3. Boy" "\t" "4. Boy" "\t" "Demir Araligi" "\t" "Demir Sira Sayisi" "\t" "Demir Standardi" "\t" "Ilk Harf" ) tk) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq ss (ssget (list (cons 0 "insert") (cons 2 "KL") ) )) (repeat (sslength ss) (setq j (1+ j)) (setq POZ1 (LM:GetAttributeValue (ssname ss j) "POZ1")) (setq CAP (LM:GetAttributeValue (ssname ss j) "CAP")) (setq BOY1 (LM:GetAttributeValue (ssname ss j) "BOY1")) (setq DAD (LM:GetAttributeValue (ssname ss j) "DAD")) (setq ARA (LM:GetAttributeValue (ssname ss j) "ARA")) (setq TIP1 (LM:GetAttributeValue (ssname ss j) "TIP1")) (setq GY1 (LM:GetAttributeValue (ssname ss j) "GY1")) (setq GY2 (LM:GetAttributeValue (ssname ss j) "GY2")) (setq GY7 (LM:GetAttributeValue (ssname ss j) "GY7")) (setq GY8 (LM:GetAttributeValue (ssname ss j) "GY8")) (setq BAD (LM:GetAttributeValue (ssname ss j) "BAD")) (setq NAD (LM:GetAttributeValue (ssname ss j) "NAD")) (setq CSTR (LM:GetAttributeValue (ssname ss j) "CSTR")) (setq SRG (LM:GetAttributeValue (ssname ss j) "SRG")) ;BOY ORTALAMA HESABI (if (vl-string-search "-" BOY1) (setq BOY1 (rtos (/ (+ (atof (substr BOY1 1 (vl-string-search "-" BOY1))) (atof (substr BOY1 (+ 2 (vl-string-search "-" BOY1))))) 2) 2 0))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;ÇİFT DONATI OLMA DURUMUNDA (if (/= NAD nil) (setq DAD (rtos ( (atof DAD) (ATOF NAD)) 2 0))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;(if (> (atof BAD) 0) ; (progn ; (if (vl-string-search "x" DAD) ; (setq DAD (rtos (* (atof (substr DAD 1 (vl-string-search "x" DAD))) ; (atof (substr DAD (+ 2 (vl-string-search "x" DAD)))) ; (atof BAD)) 2 0)) ; (setq DAD (rtos (* (atof DAD) 1) 2 0)));;(atof DAD) 1 yerine carpan ;, ; ; ) ; ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (if (= poz1 nil ) (setq poz1 "") (setq poz1 poz1)) (if (= CAP nil ) (setq poz1 "") (setq CAP CAP)) (if (= BOY1 nil ) (setq BOY1 "") (setq BOY1 BOY1)) (if (= DAD nil ) (setq DAD "") (setq DAD DAD)) (if (= ARA nil ) (setq ARA "") (setq ARA ARA)) (if (= TIP1 nil ) (setq TIP1 "") (setq TIP1 TIP1)) (if (= GY1 nil ) (setq GY1 "") (setq GY1 GY1)) (if (= GY2 nil ) (setq GY2 "") (setq GY2 GY2)) (if (= GY7 nil ) (setq GY7 "") (setq GY7 GY7)) (if (= GY8 nil ) (setq GY8 "") (setq GY8 GY8)) (if (= BAD nil ) (setq BAD "") (setq BAD BAD)) (if (= NAD nil ) (setq NAD "") (setq NAD NAD)) (if (= CSTR nil ) (setq CSTR "") (setq CSTR CSTR)) (if (= SRG nil ) (setq SRG "") (setq SRG SRG)) (write-line (strcat POZ1 "\t" CAP "\t" DAD "\t" BAD "\t" BOY1 "\t" TIP1 "\t" GY1 "\t" GY2 "\t" GY7 "\t" GY8 "\t" ARA "\t" NAD "\t" CSTR "\t" SRG ) tk) (setq POZ1 0) (setq CAP 0) (setq BOY1 0) (setq DAD 0) (setq ARA 0) (setq TIP1 0) (setq GY1 0) (setq GY2 0) (setq GY7 0) (setq GY8 0) (setq BAD 0) (setq NAD 0) (setq CSTR 0) (setq SRG 0) ) (close tk) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (princ) )(terpri) (write-line "Hazırlayan: Alpay ELMAS ( alpayelmas@gmail.com) Komut : demd") Kirişlerde Demir Metrajı Kod: (vl-load-com) (defun c:demk (/ LM:GetAttributeValue ss attValue) (defun LM:GetAttributeValue (blk tag / val enx) (while (and (null val) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget (setq blk (entnext blk)))))) ) ) (if (= (strcase tag) (strcase (cdr (assoc 2 enx)))) (setq val (cdr (assoc 1 enx))) ) ) ) (setq dosad (strcat (getvar "dwgprefix") (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4 )) )) (setq tk (open (getfiled "" dosad "xls" 9) "w")) (write-line (strcat "Poz Numarasi" "\t" "Demir Capi" "\t" "Demir Adedi" "\t" "Benzer Adedi" "\t" "Demir Boyu" "\t" "Demir Tipi" "\t" "1. Boy" "\t" "2. Boy" "\t" "3. Boy" "\t" "4. Boy" "\t" "Demir Araligi" "\t" "Demir Sira Sayisi" "\t" "Demir Standardi" "\t" "Ilk Harf" ) tk) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq kere (getint "Kiriş Adedi :")) (setq BOS "") (repeat kere (setq j -1) (princ "\nSelect text: ") (setq tx (cdr (assoc 1 (entget (ssname (ssget '((0 . "Text") (-4 . "<AND") (-4 . "<NOT") (1 . "ES") (-4 . "NOT>") (1 . "K") (8 . "KIRISNO") (-4 . "AND>") )) 0))))) (write-line tx tk) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq ss (ssget '((-4 . "<OR") (2 . "KL") (-4 . "OR>") (-4 . "<NOT") (2 . "KLPOZH") (-4 . "NOT>") ))) (repeat (sslength ss) (setq j (1+ j)) (setq POZ1 (LM:GetAttributeValue (ssname ss j) "POZ1")) (setq CAP (LM:GetAttributeValue (ssname ss j) "CAP")) (setq BOY1 (LM:GetAttributeValue (ssname ss j) "BOY1")) (setq DAD (LM:GetAttributeValue (ssname ss j) "DAD")) (setq ARA (LM:GetAttributeValue (ssname ss j) "ARA")) (setq TIP1 (LM:GetAttributeValue (ssname ss j) "TIP1")) (setq GY1 (LM:GetAttributeValue (ssname ss j) "GY1")) (setq GY2 (LM:GetAttributeValue (ssname ss j) "GY2")) (setq GY7 (LM:GetAttributeValue (ssname ss j) "GY7")) (setq GY8 (LM:GetAttributeValue (ssname ss j) "GY8")) (setq BAD (LM:GetAttributeValue (ssname ss j) "BAD")) (setq NAD (LM:GetAttributeValue (ssname ss j) "NAD")) (setq CSTR (LM:GetAttributeValue (ssname ss j) "CSTR")) (setq SRG (LM:GetAttributeValue (ssname ss j) "SRG")) ;BOY ORTALAMA HESABI (if (vl-string-search "-" BOY1) (setq BOY1 (rtos (/ (+ (atof (substr BOY1 1 (vl-string-search "-" BOY1))) (atof (substr BOY1 (+ 2 (vl-string-search "-" BOY1))))) 2) 2 0))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;ÇİFT DONATI OLMA DURUMUNDA (if (/= NAD nil) (setq DAD (rtos (* (atof DAD) (ATOF NAD)) 2 0))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;(if (> (atof BAD) 0) ; (progn ; (if (vl-string-search "x" DAD) ; (setq DAD (rtos (* (atof (substr DAD 1 (vl-string-search "x" DAD))) ; (atof (substr DAD (+ 2 (vl-string-search "x" DAD)))) ; (atof BAD)) 2 0)) ; (setq DAD (rtos (* (atof DAD) 1) 2 0)));;(atof DAD) 1 yerine carpan ;, ; ; ) ; ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (if (= poz1 nil ) (setq poz1 "") (setq poz1 poz1)) (if (= CAP nil ) (setq poz1 "") (setq CAP CAP)) (if (= BOY1 nil ) (setq BOY1 "") (setq BOY1 BOY1)) (if (= DAD nil ) (setq DAD "") (setq DAD DAD)) (if (= ARA nil ) (setq ARA "") (setq ARA ARA)) (if (= TIP1 nil ) (setq TIP1 "") (setq TIP1 TIP1)) (if (= GY1 nil ) (setq GY1 "") (setq GY1 GY1)) (if (= GY2 nil ) (setq GY2 "") (setq GY2 GY2)) (if (= GY7 nil ) (setq GY7 "") (setq GY7 GY7)) (if (= GY8 nil ) (setq GY8 "") (setq GY8 GY8)) (if (= BAD nil ) (setq BAD "") (setq BAD BAD)) (if (= NAD nil ) (setq NAD "") (setq NAD NAD)) (if (= CSTR nil ) (setq CSTR "") (setq CSTR CSTR)) (if (= SRG nil ) (setq SRG "") (setq SRG SRG)) (write-line (strcat POZ1 "\t" CAP "\t" DAD "\t" BAD "\t" BOY1 "\t" TIP1 "\t" GY1 "\t" GY2 "\t" GY7 "\t" GY8 "\t" ARA "\t" NAD "\t" CSTR "\t" SRG ) tk) (setq POZ1 0) (setq CAP 0) (setq BOY1 0) (setq DAD 0) (setq ARA 0) (setq TIP1 0) (setq GY1 0) (setq GY2 0) (setq GY7 0) (setq GY8 0) (setq BAD 0) (setq NAD 0) (setq CSTR 0) (setq SRG 0) )) (close tk) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (princ) )(terpri) (write-line "Hazırlayan: Alpay ELMAS ( alpayelmas@gmail.com) Komut : demk")

> 1 <