AutoCAD da yazıları excele aktarma lispi (satıra aktar) - Metraj Lispi

👱 Autocad de bulunan yazıları, excele satır halinde aktarmamızı sağlar,

👱 dtext ile yazılan yazıları aktarır

Autocad lisp kodlar

;      (princ "\t" dosya) OLARAK YAZILIRSA TAB'a basılmış gibi kaydeder....
;      Dosya sonra Excell de açılırken hüçrelere bölünmüş olarak açılır...
;      Yani Excell dosyası export edilmiş gibi olur.
(defun c:YAZI-EXCEL-SATIR ( / )
(command "layer" "new" "zyapimuhendisi.blogspot.com" "c" "3" "zyapimuhendisi.blogspot.com" "")
(setq donati_text (ssget '((0 . "TEXT")) ) )
(if (/= donati_text nil)
  (progn
    (setq donati_text_adet (sslength donati_text))
    (setq i 0 )
    (setq metraj_dosya (strcat (getvar "dwgprefix") (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4 )) "-YAZI-EXCEL-SATIR.xls"))
    (setq dosya (open metraj_dosya "a"))
   )
   (progn
    (princ "\n Dosyaya ara veriyoruz.......")
    (setq donati_text (ssget '((0 . "TEXT")) ) )
    (setq donati_text_adet (sslength donati_text))
    (setq i 0 )
    (setq dosya (open metraj_dosya "a"))
    (princ "\n " dosya)
    (princ "\n " dosya)
    (princ "\n " dosya)
    (princ "\n " dosya)
   )
)
   (while (< i donati_text_adet)
      (princ (cdr (assoc  1 (entget (ssname donati_text i))))  dosya)
      (setq d_eleman (entget (ssname donati_text i)))
      (setq old_feature (cdr (assoc 8 d_eleman)))
      (setq d_eleman (subst (cons 8 "zyapimuhendisi.blogspot.com") (assoc 8 d_eleman) d_eleman))
      (entmod d_eleman)
;*******************************************************************************
;                                                                              *
;     Bu satırın sonundaki t yi n yaparsanız tüm yazılar alt alta yazılır.     *
;                                                           "\t" -> "\n"       *
;*******************************************************************************
      (if (= i (- donati_text_adet 1))
        (princ "\n" dosya)
        (princ "\t" dosya)
      )
;*******************************************************************************
      (setq i (+ i 1))
   )
(close dosya)
(princ)
)

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 "YAZI-EXCEL-SATIR" yazın ve enterlayın

📜İlk satıra yazılmasını istediğiniz yazıları seçin. örnekte yazı3 yazı4 yazı seçiyorum

📜Entera bas excele aktarılan yazılar yeşil renge döner

📜İkinci satıra yazılmasını istediğiniz yazıları için tekrar YAZI-EXCEL-SATIR yazın ve yazıları secin. örnekte yazı2 yazı7 yazı6 seçiyorum
Entera basıyorum. Bu yazılarda yeşile dönüşür. yani onlarda excele aktarıldı

📜 Şimdi yazıların aktarıldığı excel dosyasını bulalım.

Autocad dosyasının bulunduğu klasore gidin
AutoCAD ile aynı isimde sonunda YAZI-EXCEL-SATIR yayzan excel dosyasını bulun.
Ben autocad-lisp isimli autocad dosyasında çalışıyorum, ve aynı klasor içinde autocad-lisp-YAZI-EXCEL-SATIR yazan excel dosyasını buluyorum.
Excel dosyasına tıkla ve aç

📜Açılan dosyada ilk seçtiğim 3 yazı ilk satırda. Sonra tekrar komutu yazıp seçtiğim yazılar ise 2.satırda göreceksiniz.

Yukarı çık

AutoCAD da yazıları excele aktarma lispi (sutuna aktar) - Metraj Lispi

👱 Autocad de seçilen yazıları excele aktarır. Seçtiğiniz herbir yazıyı excele sütuna yazar.

Autocad teki yazıları tek tek excele yazma veya kopyalayıp excele yazmaktan kurtulacaksınız.

Autocad lisp kodlar

;      (princ "\t" dosya) OLARAK YAZILIRSA TAB'a basılmış gibi kaydeder....
;      Dosya sonra Excell de açılırken hüçrelere bölünmüş olarak açılır...
;      Yani Excell dosyası export edilmiş gibi olur.
(defun c:YAZI-EXCEL-SUTUN ( / )
(command "layer" "new" "zyapimuhendisi.blogspot.com" "c" "3" "zyapimuhendisi.blogspot.com" "")
(setq donati_text (ssget '((0 . "TEXT")) ) )
(if (/= donati_text nil)
  (progn
    (setq donati_text_adet (sslength donati_text))
    (setq i 0 )
    (setq metraj_dosya (strcat (getvar "dwgprefix") (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4 )) "-YAZI-EXCEL-SUTUN.xls"))
    (setq dosya (open metraj_dosya "a"))
   )
   (progn
    (princ "\n Dosyaya ara veriyoruz.......")
    (setq donati_text (ssget '((0 . "TEXT")) ) )
    (setq donati_text_adet (sslength donati_text))
    (setq i 0 )
    (setq dosya (open metraj_dosya "a"))
    (princ "\n " dosya)
    (princ "\n " dosya)
    (princ "\n " dosya)
    (princ "\n " dosya)
   )
)
   (while (< i donati_text_adet)
      (princ (cdr (assoc  1 (entget (ssname donati_text i))))  dosya)
      (setq d_eleman (entget (ssname donati_text i)))
      (setq old_feature (cdr (assoc 8 d_eleman)))
      (setq d_eleman (subst (cons 8 "zyapimuhendisi.blogspot.com") (assoc 8 d_eleman) d_eleman))
      (entmod d_eleman)
;*******************************************************************************
;                                                                              *
;     Bu satırın sonundaki t yi n yaparsanız tüm yazılar alt alta yazılır.     *
;                                                           "\t" -> "\n"       *
;*******************************************************************************
      (if (= i (- donati_text_adet 1))
        (princ "\n" dosya)
        (princ "\n" dosya)
      )
;*******************************************************************************
      (setq i (+ i 1))
   )
(close dosya)
(princ)
)

Autocad lisp çalıştırma

📜 Komut satırına "YAZI-EXCEL-SUTUN" yazın ve enterlayın

📜 Excele aktarmak istediğiniz yazıları seçin. Sırası ile yazı3, yazı2, yazı1,yazı7 tıklıyorum.

📜Seçme işi bittikten sonra entera tıklayın. Entera bastıktan sonra yazılar yeşile dönüşecek, yeşil renge dönüşmüş yazılar. excele aktarıldı demektir.

📜Şimdi excel dosyasını bulalım

Önce autocad dosyanız hangi klasörde kayıtlı ise o klasörü açın
Autocad dosyanızla aynı isimde sonunda -YAZI-EXCEL-SUTUN yazan excel dosyasını bulun ve açın
Örnek olarak benim çalıştığım autocad dosyası autocad-lisp isimli dosya, aynı klasor içinde autocad-lisp-YAZI-EXCEL-SUTUN isinli dosyayı buluyorum ve açıyorum.

📜Excel dosyası açılınca tıkladığım butun yaziların a sutununda alt alta sıralandığını göreceksiniz.

Yukarı çık

🐃 Yazı Lispleri 🐄 Metraj Lispi lisp

AutoCAD şeçilen ölçüleri excele aktarma lispi - Metraj Lispi

👱 Bu lisp ile sadece seçilen yani sadece tıkladığım ölçüleri excele aktarır.

Autocad lisp kodlar

(defun c:OLCU-EXCEL-SECILEN (/ ss i sr d l xl n m)
  (if (setq ss (ssget '((0 . "dimension"))))
    (progn
      (repeat (setq i (sslength ss))
        (if (setq sr (vl-position (setq d (rtos (cdr (assoc 42 (entget
              (ssname ss (setq i (1- i)))))) 2 2)) (mapcar '(lambda(a) (car a)) l)))
          (setq l (subst (list (car (nth sr l)) (1+ (cadr (nth sr l)))) (nth sr l) l))
          (setq l (cons (list d 1) l))))
      (setq xl (open (getfiled "" "" "xls" 9) "w") n 0)
      (write-line (strcat "Sira No" "\t" "Dimension" "\t" "Miktar" "\t"
                    "Toplam Miktar") xl)
      (foreach m (vl-sort (mapcar '(lambda(a) (list (atof (car a)) (cadr a))) l)
                   '(lambda(a b) (< (car a) (car b))))
        (write-line (strcat (rtos (setq n (1+ n)) 2 0) "\t" (vl-string-translate "." ","
                      (rtos (car m) 2 2)) "\t" (rtos (cadr m) 2 0) "\t"
                      (strcat "=" "B" (itoa (1+ n)) "*" "C" (itoa (1+ n)))) xl))
      (write-line (strcat "\t" "Toplam" "\t"
                  (strcat "=" "TOPLA" "(" "C2" ":" "C" (itoa (1+ n)) ")") "\t"
                  (strcat "=" "TOPLA" "(" "D2" ":" "D" (itoa (1+ n)) ")")) xl)
      (close xl)
    )
  ) (princ)
)

AutoCAD lisp dosyasını kaydetme

Autocad lisp çalıştırma

Komut satırına "OLCU-EXCEL-SECILEN" yazın ve enterlayın.

Excele aktarmak istediğiniz ölçüleri tek tek secin, ve enter tuşuna basın

Örnekte önce 200
Sonra diğer 200
Sonra 400 tıklıyorum

Dosya yaratma penceresi açılacak.

Ölçülerin aktarılacağı excel dosyası nereye kayedileceğin ve ismini seçin
Kaydet tuşuna basın
Başka bir klasör ve başka bir isim yazmazsanız. çalıştığınız autocad klasörü içine ve autocad dosyası ile aynı isimde kayıt edilir.
örnekte autocad-lisp.xls olarak kayıt ediyorum

Şimdi autocad-lisp dosyasını bulup açıyorum.
3 adet ölçüye tıkladım. excele toplamda 3 ölçü aktarılmış
3 ölçünün genel toplamı verilir.

Yukarı çık

🐄 Metraj Lispi 🐉 ölçü lisp lisp

Autocad bir layerdaki bütün ölçüleri excele atma lispi - Metraj Lispi

👱 OLCU-EXCEL-LAYER lispi ile sadece bir ölçüye tıklayın. O olcü değeri hangi layerda ise , o layerdaki bütün ölçüler excel de listelenir.

Autocad lisp kodlar

AutoCAD lisp dosyasını kaydetme

Autocad lisp çalıştırma

Komut satırına "OLCU-EXCEL-LAYER" yazın ve enterlayın

Excele aktarmak istediğiniz ölçüye tıklayın.

Açılan pencerede excel dosyasının kayıt yeri seçin ve dosya adını yazın.
Kaydet tıklayın

Bir değişiklik yapmazsanız, excel dosyası otomatik olarak çalıştığınız autocad klasörü içine autocad dosyası ile aynı isimde kayıt edilir.

Kullanılacak ondalık ayracı yazın :

Burada excele aktarılan ölçülerin noktadan sonra kaç rakam görünmesini istiyorsanız yazın
2 yazarsanız noktadan sonra 2 küsürak görünür. 2 yazıp enter tuşuna basın.

Excel dosyasını bulun ve açın. farklı bir isim yazıp farklı bir klasor seçilmediyse, autocad dosyasını çalıştığınız klasore gidin ve çalıştığınız autocad dosyası ile aynı isimde excel dosyası olarak kayıt edilmiştir.
Tıkladığınız layera ait bütün ölçüler excele aktarılmış olacak. biz 1 adet ölçü tıkladık ama layerdaki bütün ölçüler aktarıldı

Yukarı çık

🐄 Metraj Lispi 🐉 ölçü lisp lisp

AutoCAD blok sayma lispi - Metraj Lispi

👱 Bu lisp ile çizim içinde seçtiğiniz bir bloktan, kaç adet olduğunu gösterir.

Autocad lisp kodlar

AutoCAD lisp dosyasını kaydetme

Autocad lisp çalıştırma

Komut satırına "BLOK-SAY" yazın ve enterlayın

Çizim içinden saymak istediğiniz bloğu seçin

Komut satırınında bu bloktan kaç adet olduğunu yazar, resimde çizim içerisinde 8 adet blok vardır. Lisp 8 adet blok olduğunu yazıyor.

Yukarı çık

🐄 Metraj Lispi 🐆 Blok Lisp lisp

AutoCAD attribute aynı girdilerin kaç adet olduğunu sayan lisp - Metraj Lispi

👱 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

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

Yukarı çık

🐕 attribute lisp lisp

AutoCAD attribute özelliklerini excelde listeleme lispi - Metraj Lispi

Ekranda bir attribute tıklıyorsunuz, o attributelere ait bütün özellikleri ekcelde listeler

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 çalıştırma

Komut satırına "ATT-EXCELDE-LISTELE" yazın ve enterlayın

Bir tane attribute tıklayın. Bu örnekte proje mahalleri attribute ile yazılmış bunlardan sadece birtanesine tıklıyorum

Bir excel dosyası açılacak. Excelde mahal isimleri ve alanlar listelenir.

Yukarı çık

🐕 attribute lisp lisp

AutoCAD uzunlukları pencerede gösterme lispi - Metraj Lispi

Lispin amacı

line uzunluklarını ölçer
polyline çizgilerin uzunluklarını ölçer
spline çizgi uzunluklarını ölçer
circle daire çevresini ölçer
arc (yay) cevre uzunluğunu ölçer
uzunluk değeri olan nesnelerin uzunluğunu ölçer.

Autocad lisp kodlar

(defun dxf (n ed) (cdr (assoc n ed)))

(defun bom-code (ssfilter        /       errexit undox   restore
                 *error* olderr  oldcmdecho      %l      %t
                 sset    %i      en      ed      p1      p2
                 ot      a1      a2      r
                )
  (defun errexit (s)
    (princ)
    (restore)
  )

(defun undox ()
    (if command-s
      (command-s "._undo" "_E")
      (command "._undo" "_E")
    )
    (setvar "cmdecho" oldcmdecho)
    (setq *error* olderr)
    (princ)
  )

(setq olderr  *error*
        restore undox
        *error* errexit
  )
  (setq oldcmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (if command-s
    (command-s "._UNDO" "_BE")
    (command "._UNDO" "_BE")
  )
  (setq %i 0
        %t 0
  )
  (vl-load-com)
  (setq sset (ssget ssfilter))
  (if sset
    (progn
      (princ "\nLengths:")
      (repeat (sslength sset)
        (setq en (ssname sset %i))
        (setq ed (entget en))
        (setq ot (dxf 0 ed))
        (setq curve (vlax-ename->vla-object en))
        (if (vl-catch-all-error-p
              (setq len (vl-catch-all-apply
                          'vlax-curve-getDistAtParam
                          (list curve
                                (vl-catch-all-apply
                                  'vlax-curve-getEndParam
                                  (list curve)
                                )
                          )
                        )
              )
            )
          nil
          len
        )
        (setq %l len)

(setq %i (1+ %i)
              %t (+ %l %t)
        )
        (terpri)
                                        ;(princ %l )
        (princ (rtos %l (getvar "lunits") (getvar "luprec")))
      )
      (princ "\nTotal = ")
                                        ;(princ %t)
      (princ (rtos %t (getvar "lunits") (getvar "luprec")))
      (textpage)
    )
  )
  (setq sset nil)
  (restore)
)

(defun bom-code-old (ssfilter        /       errexit undox   restore
                     *error* olderr  oldcmdecho      %l      %t
                     sset    %i      en      ed      p1      p2
                     ot      a1      a2      r
                    )
  (defun errexit (s)
    (princ)
    (restore)
  )

(defun undox ()
    (if command-s
      (command-s "._undo" "_E")
      (command "._undo" "_E")
    )
    (setvar "cmdecho" oldcmdecho)
    (setq *error* olderr)
    (princ)
  )

(setq olderr  *error*
        restore undox
        *error* errexit
  )
  (setq oldcmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (if command-s
    (command-s "._UNDO" "_BE")
    (command "._UNDO" "_BE")
  )
  (setq %i 0
        %t 0
  )
  (setq sset (ssget ssfilter))
  (if sset
    (progn
      (princ "\nLengths:")
      (repeat (sslength sset)
        (setq en (ssname sset %i))
        (setq ed (entget en))
        (setq ot (dxf 0 ed))
        (cond
          ((= ot "LINE")
           (setq p1 (dxf 10 ed)
                 p2 (dxf 11 ed)
                 %l (distance p1 p2)
           )
          )
          ((= ot "ARC")
           (setq a1 (dxf 50 ed)
                 a2 (dxf 51 ed)
                 r  (dxf 40 ed)
                 %l (* r (abs (- a2 a1)))
           )
          )
          (t
           (command "._area" "_obj" en)
           (setq %l (getvar "perimeter"))

)
        )
        (setq %i (1+ %i)
              %t (+ %l %t)
        )
        (terpri)
        (princ %l)
      )
      (princ "\nTotal = ")
      (princ %t)
      (textpage)
    )
  )
  (setq sset nil)
  (restore)
)

(defun c:UZUNLUK-PEN ()
  (initget "Lines Circles Arcs Ellipses Polylines Splines ALL"
  )
  (setq ans
         (getkword
           "Enter an option [Lines/Circles/Arcs/Ellipses/Polylines/Splines] : "
         )
  )
  (cond
    ((= ans "Lines") (c:bom_lines))
    ((= ans "Circles") (c:bom_circles))
    ((= ans "Arcs") (c:bom_arcs))
    ((= ans "Ellipses") (c:bom_ellipses))
    ((= ans "Polylines") (c:bom_polylines))
    ((= ans "Splines") (c:bom_splines))
    (t
     (bom-code '((-4 . "<OR")
                 (0 . "LINE")
                 (0 . "CIRCLE")
                 (0 . "ARC")
                 (0 . "ELLIPSE")
                 (0 . "POLYLINE")
                 (0 . "LWPOLYLINE")
                 (0 . "SPLINE")
                 (-4 . "OR>")
                )
     )
    )
  )
  (princ)
)

(defun c:UZUNLUK-PEN-LINES ()
  (bom-code '((0 . "LINE")))
  (princ)
)

(defun c:UZUNLUK-PEN-CIRCLES ()
  (bom-code '((0 . "CIRCLE")))
  (princ)
)

(defun c:UZUNLUK-PEN-ARCS ()
  (bom-code '((0 . "ARC")))
  (princ)
)

(defun c:UZUNLUK-PEN-ELLIPSE ()
  (bom-code '((0 . "ELLIPSE")))
  (princ)
)

(defun c:UZUNLUK-PEN-POLYLINE ()
  (bom-code '((-4 . "<OR")
              (0 . "POLYLINE")
              (0 . "LWPOLYLINE")
              (-4 . "OR>")
             )
  )
  (princ)
)

(defun c:UZUNLUK-PEN-SPLINE ()
  (bom-code '((0 . "SPLINE")))
  (princ)
)

(princ)

Autocad lisp çalıştırma

Komut satırına "UZUNLUK-PEN" yazın ve enterlayın

alternatif olarakUZUNLUK-PEN komutu yerine
UZUNLUK-PEN-SPLINE
UZUNLUK-PEN-POLYLINE
UZUNLUK-PEN-ARCS
UZUNLUK-PEN-CIRCLES
UZUNLUK-PEN-ELLIPSE.
Neyin uzunluğunu ölçmek istiyorsanız ona göre komut girin

Enter an option : Burada birşey yazmadan enter tuşuna basın

Lines çizgi ölçmek istiyorsanız line seçin
Circles - Daire çevresini ölçecekseniz bunu seçin
Arcs - Yay uzunluğunu ölçecekseniz bunu seçin
Ellipses - Elips uzunluğunu ölçmek için bunu secin
Polylines : çoklu çizgi uzunluğu ölçmek içöin bunu secin
Splines - s line uzunluğunu ölçmek için bunu seçin

Select object : uzunluğunu ölçmek sitediğiniz çizgiyi tıklayın. Örnekte line ve polyline tıklıyoruz. Enter tuşuna bas.

AutoCAD yazı penceresi açılacak
Lengths : altında 45,68 yazıyor o ilk tıkladığım line uzunluğu
Onun altında 98,07 yazıyor oda 2. tıkladığım polyline uzunluğu
3. olarak ikisinin toplam uzunluğunu veriyor.

Yukarı çık

🐄 Metraj Lispi 🐊 uzunluk lispleri lisp

Autocad yazıları aynı oranda büyütme veya küçültme lispi - Metraj Lispi

Bu lisp ile AutoCAD yazılarını belirli oranda büyütebilir veya küçültebilirsiniz.

Autocad lisp kodlar

(defun c:YAZI-BUYUT ( / ll sel obj ur )
    (initget 6)
    (if
        (and
            (setq *scl*
                (cond
                    (   (getdist (strcat "\n Yazi buyutme katsayisi secin" (if *scl* (strcat " <" (rtos *scl* 2) ">: ") ": "))))
                    (   *scl*   )
                )
            )
            (ssget "_:L")
        )
        (progn
            (vlax-for obj (setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
                (if (null (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'll 'ur))))
                    (vla-scaleentity obj
                        (vlax-3D-point
                            (mapcar '(lambda ( a b ) (/ (+ a b) 2.0))
                                (vlax-safearray->list ll)
                                (vlax-safearray->list ur)
                            )
                        )
                        *scl*
                    )
                )
            )
            (vla-delete sel)
        )
    )
    (princ)
)
(vl-load-com) (princ)

- Komut satırına YAZI-BUYUT komutunu girin