Z Yapı Mühendisi

👱 Mimari projelerde mahal isimleri, kaç m2 olduğu, ve mahal kodu genelde attribute olarak oluşturulur. Bu lisp ile seçtiğiniz bir çok attribute içinde hangi bilgi (girdi) var ve bu bilgiden (girdiden) kaç adet var sayar.

Autocad lisp kodlar

(defun c:ATT-AYNI-GIRDI-SAY nil (c:CountAttributeValues))

(defun c:CountAttributeValues ( / _Dxf _Assoc++ _SumAttributes ss i alist )

(defun _Dxf ( key alist ) (cdr (assoc key alist)))

(defun _Assoc++ ( key alist )
    (
      (lambda ( pair )
        (if pair
          (subst (list key (1+ (cadr pair))) pair alist)
          (cons  (list key 1) alist)
        )
      )
      (assoc key alist)
    )
  )

(defun _SumAttributes ( entity alist )
    (while
      (not
        (eq "SEQEND"
          (_dxf 0
            (entget
              (setq entity
                (entnext entity)
              )
            )
          )
        )
      )
      (setq alist (_Assoc++ (_Dxf 1 (reverse (entget entity))) alist))
    )
  )

(cond
    (
      (not
        (vlax-method-applicable-p
          (setq space
            (vlax-get-property
              (setq doc
                (vla-get-ActiveDocument (vlax-get-acad-object))
              )
              (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace)
            )
          )
          'AddTable
        )
      )

(princ "\n** This Version of AutoCAD Does not Support Tables **")
    )
    (
      (and (setq ss (ssget '((0 . "INSERT") (66 . 1))))
        (repeat (setq i (sslength ss))
          (setq alist (_SumAttributes (ssname ss (setq i (1- i))) alist))
        )
        (setq pt (getpoint "\nPick Point for Table: "))
      )
     
      (LM:AddTable space (trans pt 1 0) "Attribute Totals"
        (cons '("Value" "Total")
          (vl-sort
            (mapcar
              (function
                (lambda ( pair )
                  (list (car pair) (itoa (cadr pair)))
                )
              )
              alist
            )
            (function (lambda ( a b ) (< (strcase (car a)) (strcase (car b)))))
          )
        )
      )
    )
  )

(princ)
)

;;---------------------=={ Add Table }==----------------------;;
;;                                                            ;;
;;  Creates a VLA Table Object at the specified point,        ;;
;;  populated with title and data                             ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  space - VLA Block Object                                  ;;
;;  pt    - Insertion Point for Table                         ;;
;;  title - Table title                                       ;;
;;  data  - List of data to populate the table                ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Table Object                                ;;
;;------------------------------------------------------------;;

(defun LM:AddTable ( space pt title data / _itemp ) (vl-load-com)

(defun _itemp ( collection item )
    (if
      (not
        (vl-catch-all-error-p
          (setq item
            (vl-catch-all-apply 'vla-item (list collection item))
          )
        )
      )
      item
    )
  )

(
    (lambda ( table ) (vla-put-StyleName table (getvar 'CTABLESTYLE)) (vla-SetText table 0 0 title)
      (
        (lambda ( row )
          (mapcar
            (function
              (lambda ( rowitem ) (setq row (1+ row))
                (
                  (lambda ( column )
                    (mapcar
                      (function
                        (lambda ( item )
                          (vla-SetText table row
                            (setq column (1+ column)) item
                          )
                        )
                      )
                      rowitem
                    )
                  )
                  -1
                )
              )
            )
            data
          )
        )
        0
      )
      table
    )
    (
      (lambda ( textheight )
        (vla-AddTable space (vlax-3D-point pt) (1+ (length data)) (length (car data)) (* 1.8 textheight)
          (* textheight
            (apply 'max
              (cons (/ (strlen title) (length (car data)))
                (mapcar 'strlen (apply 'append data))
              )
            )
          )
        )
      )
      (vla-getTextHeight
        (_itemp
          (_itemp
            (vla-get-Dictionaries
              (vla-get-ActiveDocument (vlax-get-acad-object))
            )
            "ACAD_TABLESTYLE"
          )
          (getvar 'CTABLESTYLE)
        )
        acDataRow
      )
    )
  )
)

(princ)

AutoCAD lisp dosyasını kaydetme

Lisp dosyasını oluşturmayı ve AutoCAD"e yüklemeyi bilmiyorsanız. Lispi bilgisayara kaydetmek ve AutoCAD"e yüklemek için AutoCAD lisp dosyasını kaydetme ve yükleme nasıl yapılır yazısını okuyun

Autocad lisp çalıştırma

Komut satırına "ATT-AYNI-GIRDI-SAY" yazın ve enterlayın

Özelliklerini saymak istediğiniz attributeleri seçiniz. Enter tuşuna basın

Pick Point for Table : Tabloyu yerleştirmek istediğiniz yeri şeçin.
İlk sutunda girdiler
İkinci sutunda kaç adet olduğu yazar

AutoCAD attribute aynı girdilerin kaç adet olduğunu sayan lisp daha fazla ara

👀 google

👀 yandex

👀 bing

👀 youtube

👀 facebook

👀 wikipedia

👀 google kitap

👀 google trends

👀 uzmantv

👀 twitter

👀 pinterest

👀 eksisozluk

AutoCAD attribute aynı girdilerin kaç adet olduğunu sayan lisp ilgili benzer konular

👀 AutoCAD nesne SAYMA lispi

👀 AutoCAD Mahal listesi oluşturma

👀 Autocad mahal lisp

👀 AutoCAD nesne sayma komutu

👀 AutoCAD mahal listesi excele aktarma

👀 BCOUNT komutu

👀 AutoCAD blok sayma lisp

👀 AutoCAD mahal etiketi

autocad lisp etiketli pin pano

Autocad lisp kodlar

(defun c:ATT-EXCELDE-LISTELE (/ AtR Books EbL ExB ExceLApp ExCeLLs myerr n NewBook olderr PaT
               PvT rn Sheet1 Sheets sTn sTr VaL)
  (defun myerr (errmsg)
    (if (/= errmsg "\nFunction cancelled") (prompt (strcat "\n" errmsg)))
    (command "._undo" "_e") (command "._U") (setq *error* olderr) (princ))
  (setvar "cmdecho" 0) (command "undo" "group") (vl-load-com) (princ "\n")
  (setq olderr *error* *error* myerr) (*push-error-using-command*)
  (while (not ExB) (princ "\r Attribute Export edilecek Block'u seçiniz.")
    (setq ExB (ssget ":s" (list (cons 0 "INSERT")))
          ExB (cdr (assoc 2 (entget (ssname ExB 0)))))
    (if (/= (cdr(assoc 70 (entget(tblobjname "Block" ExB)))) 2)(setq ExB nil)))
  (setq ExceLApp (vlax-get-or-create-object "Excel.Application"))
  (if (setq NewBook (vlax-get-property ExceLApp "ActiveWorkbook"))
    (setq Books  (vlax-get-property ExceLApp "Workbooks")
          Sheets (vlax-get-property NewBook "Sheets")
          Sheet1 (vlax-invoke-method Sheets "Add"))
    (setq Books   (vlax-get-property ExceLApp "Workbooks")
          NewBook (vlax-invoke-method Books "Add")
          Sheets  (vlax-get-property NewBook "Sheets")
          Sheet1  (vlax-get-property Sheets "Item" 1)))
  (setq ExCeLLs (vlax-get-property Sheet1 "Cells"))
  (vlax-put-property ExceLApp "UseSystemSeparators" :vlax-false)
  (vlax-put-property ExceLApp "DecimalSeparator" ".")
  (vlax-put-property ExceLApp "ThousandsSeparator" " ")
  (vla-put-visible ExceLApp :vlax-true)
  (setq PvT (tblobjname "Block" ExB) sTn 0 sTr 1)
  (while (setq PvT (entnext PvT))
    (if (= (cdr (assoc 0 (entget PvT))) "ATTDEF") 
      (progn (setq sTn (1+ sTn)
                   AtR (append AtR (list (cdr (assoc 2 (entget PvT))))))
     (vlax-put-property ExCeLLs "Item" sTr sTn (cdr (assoc 3 (entget PvT)))))))
  (setq EbL (ssget "x" (list (cons 0 "INSERT") (cons 2 ExB))) n -1)
  (while (< (setq n (1+ n)) (sslength EbL))
    (setq sTr (1+ sTr) PvT (ssname EbL n))
    (while (= "ATTRIB" (cdr (assoc 0 (entget (setq PvT (entnext PvT))))))
      (setq PaT (cdr (assoc 2 (entget PvT))) VaL (cdr (assoc 1 (entget PvT))))
      (vlax-put-property ExCeLLs "Item" sTr (1+ (vl-position Pat AtR)) VaL)))
  (setq rn (vlax-get-property ExCeLLs "Range"
             (vlax-variant-value (vlax-get-property ExCeLLs 'Item 1 1))
             (vlax-variant-value (vlax-get-property ExCeLLs 'Item sTr sTn))))
  (vlax-invoke-method (vlax-get-property rn 'Columns) 'AutoFit)
  (vlax-invoke-method (vlax-get-property rn 'Rows) 'AutoFit)
  (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-put-property ExcelApp "UseSystemSeparators" :vlax-true)
  (mapcar 'vlax-release-object 
          (list rn ExCeLLs Sheet1 Sheets NewBook Books ExcelApp))
  (setq ExcelApp nil) (gc) (gc)
  (command "_.undo" "end") (setq *error* olderr) (*pop-error-mode*) (prin1))

AutoCAD lisp dosyasını kaydetme ve yükleme nasıl yapılır