Forum
Download
Galeri
Üye Ol
|
Giriş
AutoCAD
•
AutoLISP
•
Programlama
•
Püfler
•
Komutlar
•
Terimler
•
Eğitim
aLd
•
TCad
•
FacadeCAD
•
Cephe Kot
•
HQ Library
•
FreeMUST
•
Pasdoc.A
Forumlar
>
Acemi AutoLISP
>
polyline alanlarını toplayıp , layerine göre tablo yapan lisp
88141
09.05.2020 16:10
ahmetcemoz
iyi günler
polyline alanlarını toplayıp , layerine göre Autocad içinde tablo yapan lisp var mı?
Uzunlukları için olanı bulmuştum(LAYLENGTH.LSP)
88142
12.05.2020 13:27
ehya
Kod:
(defun c:M2T (/ alan_lst secalan c tek data alan layer aa pt mytbl z)
(setq alan_lst '())
(setq obj (vlax-get-acad-object))
(setq doc (vla-get-ActiveDocument obj))
(setq mspace (vla-get-modelspace doc))
(if (setq secalan (ssget (list (cons 0 "LWPOLYLINE"))))
(progn
(setq c -1)
(repeat (sslength secalan)
(setq tek (ssname secalan (setq c (1+ c)))
data (vlax-ename->vla-object tek)
alan (vla-get-area data)
layer (vla-get-layer data))
(if (not (assoc layer alan_lst))
(setq alan_lst (cons (cons layer alan) alan_lst))
(setq aa (cdr (assoc layer alan_lst))
aa (+ aa alan)
alan_lst (subst (cons layer aa)(assoc layer alan_lst) alan_lst)
)))
(if (setq pt (getpoint "\nTablo için bir yer gösterin:"))
(progn
(setq mytbl (vla-addtable
mspace
(vlax-3d-point pt)
(+ (length alan_lst) 2)
2
25
150
)
)
(vla-setcellvalue mytbl 0 0 "ALAN HESABI")
(vla-SetTextHeight mytbl acTitleRow 13)
(vla-setcellvalue mytbl 1 0 "LAYER ADI")
(vla-setcellvalue mytbl 1 1 "ALANI")
(vla-SetTextHeight mytbl acHeaderRow 10)
(setq z 0)
(vla-SetTextHeight mytbl acDataRow 10)
(vla-setalignment mytbl acDataRow acmiddlecenter)
(repeat (length alan_lst)
(vla-setcellvalue mytbl (+ z 2) 0 (car (nth z alan_lst)))
(vla-setcellvalue mytbl (+ z 2) 1 (strcat (rtos (/ (cdr (nth z alan_lst))10000.00)2 2) " m2"))
(setq z (1+ z)))
))))(princ))
ehya (12.05.2020 13:51 GMT)
>
1
<
Copyright © 2004-2022 SQL: 0.984 saniye - Sorgu: 46 - Ortalama: 0.02139 saniye