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)

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