Z Yapı Mühendisi

🐄 Metraj Lispi etiketine sahip kayıtlar gösteriliyor. Tüm kayıtları göster

+ Bir veya birkaç alan ve çevresi olan şekillerin. toplam alan ve toplam çevresini istediğiniz yere yazdırma lispi.

AutoCAD toplam alan veya toplam çevreyi istediğin yere yazdırma

Autocad lisp kodlar

;;----------------------------------------------------------------------;;
;; Length Field Commands    UZUNLUK YAZMA  KOMUTLARI                             ;;
;;----------------------------------------------------------------------;;

(defun c:UZUNLUK-YAZ  ( ) (lengthfield nil "%lu6"))            ;; Current units CEVRE CM YAZ
(defun c:UZUNLUK-YAZ-0,01 ( ) (lengthfield nil "%lu6%ct8[0.01]")) ;; Current units with 0.01 conversion factor (cm->m) CEVRE METRE YAZ

;;----------------------------------------------------------------------;;
;; Area Field Commands         ALAN YAZMA KOMUTLARI                                         ;;
;;----------------------------------------------------------------------;;

(defun c:ALAN-YAZ  ( ) (areafield nil "%lu6%qf1"))           ;; Current units ALAN CM YAZ
(defun c:ALAN-YAZ-0,001 ( ) (areafield nil "%lu6%qf1%ct8[1e-4]")) ;; Current units with 1e-4 (0.0001) conversion factor (cm2->m2) ALAN METRE YAZ

(defun lengthfield ( tag fmt / *error* idx lst obj prp sel )
    
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
    
    (LM:startundo (LM:acdoc))
    (setq prp
       '(
            ("AcDbArc"        . "ArcLength")
            ("AcDbCircle"     . "Circumference")
            ("AcDbLine"       . "Length")
            ("AcDbPolyline"   . "Length")
            ("AcDb2dPolyline" . "Length")
            ("AcDb3dPolyline" . "Length")
        )
    )

(if
        (setq sel
            (LM:ssget "\nSelect objects to obtain total length <exit>: "
                (list
                    (list
                       '(000 . "ARC,CIRCLE,LINE,*POLYLINE")
                       '(-04 . "<NOT")
                           '(-04 . "<AND")
                               '(000 . "POLYLINE") '(-04 . "&") '(070 . 80)
                           '(-04 . "AND>")
                       '(-04 . "NOT>")
                        (if (= 1 (getvar 'cvport))
                            (cons 410 (getvar 'ctab))
                           '(410 . "Model")
                        )
                    )
                )
            )
        )
        (LM:outputtext tag
            (if (= 1 (sslength sel))
                (progn
                    (setq obj (vlax-ename->vla-object (ssname sel 0)))
                    (strcat
                        "%<\\AcObjProp Object(%<\\_ObjId "
                        (LM:objectid obj)
                        ">%)." (cdr (assoc (vla-get-objectname obj) prp))
                        (if (and fmt (/= "" fmt)) (strcat " \\f \"" fmt "\">%") ">%")
                    )
                )
                (progn
                    (repeat (setq idx (sslength sel))
                        (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))
                              lst
                            (vl-list*
                                "%<\\AcObjProp Object(%<\\_ObjId "
                                (LM:objectid obj)
                                ">%)." (cdr (assoc (vla-get-objectname obj) prp)) ">%" " + "
                                lst
                            )
                        )
                    )
                    (strcat
                        "%<\\AcExpr "
                        (apply 'strcat (reverse (cdr (reverse lst))))
                        (if (and fmt (/= "" fmt)) (strcat " \\f \"" fmt "\">%") ">%")
                    )
                )
            )
        )
    )
    (*error* nil) (princ)
)

;;----------------------------------------------------------------------;;

(defun areafield ( tag fmt / *error* idx lst sel )

(defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
    
    (LM:startundo (LM:acdoc))

(if
        (setq sel
            (LM:ssget "\nSelect objects to obtain total area <exit>: "
                (list
                    (list
                       '(000 . "ARC,CIRCLE,ELLIPSE,HATCH,*POLYLINE,REGION,SPLINE")
                       '(-04 . "<NOT")
                           '(-04 . "<AND")
                               '(000 . "POLYLINE") '(-04 . "&") '(070 . 88)
                           '(-04 . "AND>")
                       '(-04 . "NOT>")
                        (if (= 1 (getvar 'cvport))
                            (cons 410 (getvar 'ctab))
                           '(410 . "Model")
                        )
                    )
                )
            )
        )
        (LM:outputtext tag
            (if (= 1 (sslength sel))
                (strcat
                    "%<\\AcObjProp Object(%<\\_ObjId "
                    (LM:objectid (vlax-ename->vla-object (ssname sel 0)))
                    ">%).Area"
                    (if (and fmt (/= "" fmt)) (strcat " \\f \"" fmt "\">%") ">%")
                )
                (progn
                    (repeat (setq idx (sslength sel))
                        (setq lst
                            (vl-list*
                                "%<\\AcObjProp Object(%<\\_ObjId "
                                (LM:objectid (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
                                ">%).Area>%" " + "
                                lst
                            )
                        )
                    )
                    (strcat
                        "%<\\AcExpr "
                        (apply 'strcat (reverse (cdr (reverse lst))))
                        (if (and fmt (/= "" fmt)) (strcat " \\f \"" fmt "\">%") ">%")
                    )
                )
            )
        )
    )
    (*error* nil) (princ)
)

;; Output Text  -  Lee Mac
;; Prompts the user to specify a point at which to create an MText object containing the supplied string or to
;; select a table cell, text, mtext, multileader, attribute, or attributed block to be populated with the supplied string.
;; tag - [str] Optional target attribute tag
;; str - [str] Field expression or other text content

(defun LM:outputtext ( tag str / ent enx flg idx obj oid sel tab tmp typ )
    (if
        (setq tmp
            (ssget "_X"
                (list '(0 . "ACAD_TABLE")
                    (if (= 1 (getvar 'cvport))
                        (cons 410 (getvar 'ctab))
                       '(410 . "Model")
                    )
                )
            )
        )
        (repeat (setq idx (sslength tmp))
            (setq tab (cons (vlax-ename->vla-object (ssname tmp (setq idx (1- idx)))) tab))
        )
    )
    (while
        (not
            (progn
                (if flg
                    (progn
                        (setvar 'errno 0)
                        (initget "Point eXit")
                        (setq sel (nentsel "\nSelect text, mtext, mleader, attribute or attributed block [Point/eXit] <eXit>: "))
                    )
                    (progn
                        (initget "Object eXit")
                        (setq sel (getpoint "\nSpecify point or table cell [Object/eXit] <eXit>: "))
                    )
                )
                (cond
                    (   (= 7 (getvar 'errno))
                        (prompt "\nMissed, try again.")
                    )
                    (   (or (null sel) (= "eXit" sel)))
                    (   (= "Point" sel)
                        (setq flg nil)
                    )
                    (   (= "Object" sel)
                        (not (setq flg t))
                    )
                    (   flg
                        (setq ent (car sel)
                              enx (entget ent)
                              typ (cdr (assoc 0 enx))
                              obj (vlax-ename->vla-object ent)
                        )
                        (cond
                            (   (and (= 2 (length sel)) (wcmatch typ "TEXT,MTEXT"))
                                (if (vlax-write-enabled-p obj)
                                    (LM:outputtext:puttextstring obj str)
                                    (prompt "\nThe selected text object is on a locked layer.")
                                )
                            )
                            (   (and (= "ATTRIB" typ)
                                     (/= 'str (type tag))
                                )
                                (if (vlax-write-enabled-p obj)
                                    (progn
                                        (LM:outputtext:puttextstring obj str)
                                        (if (wcmatch (strcase str t) "*%<\\ac*>%*") (LM:outputtext:updatefield ent))
                                    )
                                    (prompt "\nThe selected attribute is on a locked layer.")
                                )
                            )
                            (   (and
                                    (or
                                        (and (= "ATTRIB" typ)
                                             (setq tmp (cdr (assoc 330 enx)))
                                        )
                                        (and (setq tmp (last (cadddr sel)))
                                             (= "INSERT" (cdr (assoc 0 (entget tmp))))
                                        )
                                    )
                                    (setq tmp (vlax-invoke (vlax-ename->vla-object tmp) 'getattributes))
                                    (or
                                        (and (= 'str (type tag))
                                             (setq idx (vl-position (strcase tag) (mapcar 'vla-get-tagstring tmp)))
                                             (setq obj (nth idx tmp))
                                        )
                                        (and (not (cdr tmp))
                                             (setq obj (car tmp))
                                        )
                                        (and (setq idx (LM:listbox "Choose Attribute" (mapcar 'vla-get-tagstring tmp) 2))
                                             (setq obj (nth (car idx) tmp))
                                        )
                                    )
                                )
                                (if (vlax-write-enabled-p obj)
                                    (progn
                                        (LM:outputtext:puttextstring obj str)
                                        (if (wcmatch (strcase str t) "*%<\\ac*>%*") (LM:outputtext:updatefield (vlax-vla-object->ename obj)))
                                    )
                                    (prompt "\nThe selected attribute is on a locked layer.")
                                )
                            )
                            (   (and (= 2 (length sel)) (= "MULTILEADER" typ))
                                (setq typ (cdr (assoc 172 (reverse enx))))
                                (cond
                                    (   (and (<= acblockcontent typ acmtextcontent) (not (vlax-write-enabled-p obj)))
                                        (prompt "\nThe selected multileader is on a locked layer.")
                                    )
                                    (   (= acmtextcontent typ)
                                        (LM:outputtext:puttextstring obj str)
                                        (if (wcmatch (strcase str t) "*%<\\ac*>%*") (vla-regen (LM:acdoc) acactiveviewport))
                                        t
                                    )
                                    (   (and
                                            (= acblockcontent typ)
                                            (setq tmp (LM:getmleaderattributes obj))
                                            (or
                                                (and (= 'str (type tag))
                                                     (setq oid (cdr (assoc (strcase tag) tmp)))
                                                )
                                                (and (not (cdr tmp))
                                                     (setq oid (cdar tmp))
                                                )
                                                (and (setq idx (LM:listbox "Choose Attribute" (mapcar 'car tmp) 2))
                                                     (setq oid (cdr (nth (car idx) tmp)))
                                                )
                                            )
                                        )
                                        (LM:setmleaderattributevalue obj oid str)
                                        (if (wcmatch (strcase str t) "*%<\\ac*>%*") (vla-regen (LM:acdoc) acactiveviewport))
                                        t
                                    )
                                    (   (prompt "\nThe select multileader has no editable content."))
                                )
                            )
                            (   (prompt "\nThe selected object is not text, mtext, multileader, attribute or attributed block."))
                        )
                    )
                    (   (setq tmp (LM:getcell tab (trans sel 1 0)))
                        (if (vlax-write-enabled-p (car tmp))
                            (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-settext (append tmp (list str)))))
                            (prompt "\nThe selected table cell belongs to a table on a locked layer.")
                        )
                    )
                    (   (vla-addmtext
                            (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
                            (vlax-3D-point (trans sel 1 0))
                            0.0
                            str
                        )
                    )
                )
            )
        )
    )
)

(defun LM:outputtext:puttextstring ( obj str )
    (vla-put-textstring obj "") ;; To clear any existing field
    (vla-put-textstring obj str)
    t
)

(defun LM:outputtext:updatefield ( ent / cmd rtn )
    (setq cmd (getvar 'cmdecho))
    (setvar 'cmdecho 0)
    (setq rtn (vl-cmdf "_.updatefield" ent ""))
    (setvar 'cmdecho cmd)
    rtn
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
    (princ msg)
    (setvar 'nomutt 1)
    (setq sel (vl-catch-all-apply 'ssget arg))
    (setvar 'nomutt 0)
    (if (not (vl-catch-all-error-p sel)) sel)
)

;; Get MLeader Attributes  -  Lee Mac
;; Returns an association list of attribute tags & object IDs for all attributes held by an mleader block
;; mld - [vla] MLeader vla-object
;; Returns: [lst] List of ((<Attribute Tag> . <Object ID>) ... )

(defun LM:getmleaderattributes ( mld / rtn )
    (vlax-for obj (vla-item (vla-get-blocks (vla-get-document mld)) (vla-get-contentblockname mld))
        (if
            (and
                (= "AcDbAttributeDefinition" (vla-get-objectname obj))
                (= :vlax-false (vla-get-constant obj))
            )
            (setq rtn (cons (cons (strcase (vla-get-tagstring obj)) (LM:intobjectid obj)) rtn))
        )
    )
    (reverse rtn)
)

;; Object ID (integer)  -  Lee Mac
;; Returns an integer representing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems

(defun LM:intobjectid ( obj )
    (if (vlax-property-available-p obj 'objectid32)
        (defun LM:intobjectid ( obj ) (vla-get-objectid32 obj))
        (defun LM:intobjectid ( obj ) (vla-get-objectid   obj))
    )
    (LM:intobjectid obj)
)

;; Set MLeader Attribute Value  -  Lee Mac
;; obj - [vla] MLeader vla-object
;; idx - [int] Attribute Definition Object ID
;; str - [str] Attribute value

(defun LM:setmleaderattributevalue ( obj idx str )
    (if (vlax-method-applicable-p obj 'setblockattributevalue32)
        (defun LM:setmleaderattributevalue ( obj idx str ) (vla-setblockattributevalue32 obj idx str))
        (defun LM:setmleaderattributevalue ( obj idx str ) (vla-setblockattributevalue   obj idx str))
    )
    (LM:setmleaderattributevalue obj idx str)
)

;; List Box  -  Lee Mac
;; Displays a DCL list box allowing the user to make a selection from the supplied data.
;; msg - [str] Dialog label
;; lst - [lst] List of strings to display
;; bit - [int] 1=allow multiple; 2=return indexes
;; Returns: [lst] List of selected items/indexes, else nil
 
(defun LM:listbox ( msg lst bit / dch des tmp rtn )
    (cond
        (   (not
                (and
                    (setq tmp (vl-filename-mktemp nil nil ".dcl"))
                    (setq des (open tmp "w"))
                    (write-line
                        (strcat "listbox:dialog{label=\"" msg "\";spacer;:list_box{key=\"list\";multiple_select="
                            (if (= 1 (logand 1 bit)) "true" "false") ";width=50;height=15;}spacer;ok_cancel;}"
                        )
                        des
                    )
                    (not (close des))
                    (< 0 (setq dch (load_dialog tmp)))
                    (new_dialog "listbox" dch)
                )
            )
            (prompt "\nError Loading List Box Dialog.")
        )
        (   t     
            (start_list "list")
            (foreach itm lst (add_list itm))
            (end_list)
            (setq rtn (set_tile "list" "0"))
            (action_tile "list" "(setq rtn $value)")
            (setq rtn
                (if (= 1 (start_dialog))
                    (if (= 2 (logand 2 bit))
                        (read (strcat "(" rtn ")"))
                        (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")")))
                    )
                )
            )
        )
    )
    (if (< 0 dch)
        (unload_dialog dch)
    )
    (if (and tmp (setq tmp (findfile tmp)))
        (vl-file-delete tmp)
    )
    rtn
)

;; Get Cell  -  Lee Mac
;; If the supplied point lies within a cell boundary,
;; returns a list of: (<VLA Table Object> <Row> <Col>)
 
(defun LM:getcell ( lst pnt / dir )
    (setq dir (vlax-3D-point (trans (getvar 'viewdir) 1 0))
          pnt (vlax-3D-point pnt)
    )
    (vl-some
       '(lambda ( tab / row col )
            (if (= :vlax-true (vla-hittest tab pnt dir 'row 'col))
                (list tab row col)
            )
        )
        lst
    )
)

;; ObjectID  -  Lee Mac
;; Returns a string containing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems

(defun LM:objectid ( obj )
    (eval
        (list 'defun 'LM:objectid '( obj )
            (if (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
                (if (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
                    (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
                   '(LM:ename->objectid (vlax-vla-object->ename obj))
                )
               '(itoa (vla-get-objectid obj))
            )
        )
    )
    (LM:objectid obj)
)

;; Entity Name to ObjectID  -  Lee Mac
;; Returns the 32-bit or 64-bit ObjectID for a supplied entity name

(defun LM:ename->objectid ( ent )
    (LM:hex->decstr
        (setq ent (vl-string-right-trim ">" (vl-prin1-to-string ent))
              ent (substr ent (+ (vl-string-position 58 ent) 3))
        )
    )
)

;; Hex to Decimal String  -  Lee Mac
;; Returns the decimal representation of a supplied hexadecimal string

(defun LM:hex->decstr ( hex / foo bar )
    (defun foo ( lst rtn )
        (if lst
            (foo (cdr lst) (bar (- (car lst) (if (< 57 (car lst)) 55 48)) rtn))
            (apply 'strcat (mapcar 'itoa (reverse rtn)))
        )
    )
    (defun bar ( int lst )
        (if lst
            (if (or (< 0 (setq int (+ (* 16 (car lst)) int))) (cdr lst))
                (cons (rem int 10) (bar (/ int 10) (cdr lst)))
            )
            (bar int '(0))
        )
    )
    (foo (vl-string->list (strcase hex)) nil)
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

;;----------------------------------------------------------------------;;

(vl-load-com)
(princ
    (strcat
        "\n Toplam alanı yazmak için ALAN-YAZ giriniz"
        "\n Toplam Uzunluğu yazmak için UZUNLUK-YAZ giriniz"
        "\n Z Yapı Mühendisi"
    )
)
(princ)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

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

Toplam alanı yazma

- komut satırına "ALAN-YAZ" yazın ve enter düğmesine basın

- Alanları yazmak istediğiniz şekilleri seçin enter tuşuna basın

- alanı yazmak istediğiniz yeri secin

1--herhangi boş bir yere tıklayın

--- alan tıkladığınız yere yazılacak

2 --- alanı ekranda yazılı bir yazının üzerine yazdırma

---Alanları yazmak istediğiniz şekilleri seçip

--- enter düğmesine bastıktan sonra

--- Object (nesne ) seçeneği için O yazın ve enterlayın veya object tıklayın

--- üzerine yazmak istediğiniz yazıya tıklayın. örnekte yazı7 tıklıyorum

--- yazı7 yi tıkladıktan sonra, yazı7 yerine toplam alan yazılacaktır.

Toplam uzunluğu yazma lispi

Alan yazna kısmında adımlar aynen uygulanır. Burada ALAN-YAZ yerine UZUNLUK-YAZ yazılır.

--- Kumanda satırına "UZUNLUK-YAZ" yazın.

--- Nesneleri seçin ve enter tuşuna basın.

--- Uzunluk yazmak istediğiniz yere tıklayın.

--- toplam uzunluk yazılacak.

AutoCAD toplam alan veya toplam çevreyi istediğin yere yazdırma - Metraj Lispi

Hiç yorum yok:
3 Mart 2021 Çarşamba

🐄 Metraj Lispi 🐅 Alan-Çevre Lispleri lisp

Autocad de tıkladığın herhangi iki nokta arasındaki uzaklığı yazar.

Autocad lisp kodlar

AutoCAD iki nokta arasındaki uzunluğu yazan lisp resimli anlatım

- Komut satırına "UZUNLUK-IKI-NOKTA" yazın ve enter tuşuna basın

- yazi boyu istenecek, yazılacak yazının yüksekliğini belirleyin. 10 20 100 şeklinde bir sayı giriniz

- ben yazı boyunu 4 yazıp entera basıyorum

- ilk noktayı giriniz : ilk noktaya ekranda tıklayınız

- ikinci noktaya ekranda tıklayınız

- ikinci noktaya tıkladıktan sonra arasındaki mesafeyi üzerine yazar

AutoCAD iki nokta arasındaki uzunluğu yazan lisp daha fazla ara

👀 google

👀 yandex

👀 bing

👀 youtube

👀 facebook

👀 wikipedia

👀 google kitap

👀 google trends

👀 uzmantv

👀 twitter

👀 pinterest

👀 eksisozluk

AutoCAD iki nokta arasındaki uzunluğu yazan lisp ilgili benzer konular

👀 autocad uzunluk ölçme komutu

👀 autocad seçilen çizgilerin toplam uzunluğu

👀 autocad çizgi uzunluğu gösterme

👀 autocad kot verme

👀 autocad spline uzunluğu ölçme kısayol

👀 autocad uzunluk yazma

👀 harocad lisp

AutoCAD iki nokta arasındaki uzunluğu yazan lisp - Metraj Lispi

Hiç yorum yok:

🐄 Metraj Lispi 🐊 uzunluk lispleri lisp

Bir kaç çizginin uzunluklarını toplayarak toplam uzunluğunu verir.

Autocad lisp kodlar

(defun c:UZUNLUK-METRAJ ()
  (setvar "modemacro" "zyapimuhendisi.blogspot.com")
  (vl-load-com)
  (setq secim (ssget '((-4 . "<OR")
       (0 . "LINE")
       (0 . "LWPOLYLINE")
       (0 . "ARC")
       (0 . "ELLIPSE")
       (0 . "SPLINE")
       (0 . "CIRCLE")
       (-4 . "OR>")
      )
      )
  )
  (if (= secim nil)
    (progn
    )
    (progn
      (setq sayim (sslength secim))
      (setq toplami 0
    c 0
      )
      (while (< c sayim)
(setq teksecim (ssname secim c))
(setq tanimi (cdr (assoc 0 (entget teksecim))))
(if (= tanimi "ARC")
  (progn
    (setq data (vlax-ename->vla-object teksecim))
    (setq uz-bul (vla-get-arclength data))
    (setq toplami (+ toplami uz-bul))
  ))
(if (or (= tanimi "LINE")(= tanimi "LWPOLYLINE")(= tanimi "POLYLINE"))
  (progn
    (setq data (vlax-ename->vla-object teksecim))
    (setq uz-bul (vla-get-length data))
    (setq toplami (+ toplami uz-bul))
  )
)
(if (= tanimi "CIRCLE")
  (progn
    (setq data (vlax-ename->vla-object teksecim))
    (setq uz-bul (vla-get-circumference data))
    (setq toplami (+ toplami uz-bul))))
(if (or (= tanimi "ELLIPSE")(= tanimi "SPLINE"))
  (progn
    (command "._area" "e" teksecim)
    (setq uz-bul (getvar "perimeter"))
    (setq toplami (+ toplami uz-bul))))
(setq c (+ c 1))
      )
      (alert (strcat "\nToplam Uzunluk : " (rtos toplami 2 3)))
    )
  )
  (princ)
)

Autocad lisp çalıştırma

Kumanda satırına UZUNLUK-METRAJ yazın ve enter tuşuna basın
Metrajını almak istediğiniz çizgilere ekranda tıklayın veya toplu seçin
Line ve polyline hepsini seçiyorum
Enter tuşuna basın.
Kaç şekil seçildiği kumanda satırında yazar
Toplam uzunluk açılan pencerede yazar

AutoCAD çizgileri toplayan lips - Metraj Lispi

Hiç yorum yok:
2 Mart 2021 Salı

🐄 Metraj Lispi 🐊 uzunluk lispleri lisp

🍅 Alanlarını bulmak istediğiniz bir veya bir kaç nesneye tıkladığınızda, Toplam alanları komut satırında gösteren lisp.

Autocad lisp kodlar

(defun c:ALAN-SATIRDA-GOSTER (/ olderr oldcmdecho errexit undox restore ss1 nr en tot_area)
  (defun errexit (s)
    (restore)
  )

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

(setq olderr  *error*
        restore undox
        *error* errexit
  )
  (setq oldcmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "._UNDO" "_BE")
  (if (setq ss1 (ssget '((-4 . "<OR")
                         (0 . "POLYLINE")
                         (0 . "LWPOLYLINE")
                         (0 . "CIRCLE")
                         (0 . "ELLIPSE")
                         (0 . "SPLINE")
                         (0 . "REGION")
                         (-4 . "OR>")
                        )
                )
      )
    (progn
      (setq nr 0)
      (setq tot_area 0.0)
      (setq en (ssname ss1 nr))
      (while en
        (command "._area" "_O" en)
        (setq tot_area (+ tot_area (getvar "area")))
        (setq nr (1+ nr))
        (setq en (ssname ss1 nr))
      )
      (princ "\nTotal Area = ")
      (princ tot_area)
    )
  )
  (setq ss1 nil)
  (restore)
)

Autocad lisp çalıştırma

📜 Komut satırına "ALAN-TOPLAM" yazın ve enterlayın

📜Select object : Toplam alanı bulmak istediğiniz şekle tıklayın
Kareye tıklıyorum

📜Enter tuşuna basıyorum. Total area = 10000 birim kare

📜Şimdi başka bir şeklin alanı görelim.
ALAN-TOPLAM yazdım ve enter tuşuna bastım
İkin şekli şeçiyorum

📜Enter tuşuna basıyorum.
Select objects: 1 found
Select objects:
Total Area = 6759.27
2. şeklin alanı 6759,27 birim kare

📜Şimdi birden çok şeklin toplam alanını bulualım

kumanda satırına ALAN-TOPLAM yazıyorum
enter tuşuna basıyorum
alanını bulmak istediğim şekilleri (birkaçtane şekil seçiyorum)
Şekildeki 3 şekli seciyorum

📜enter tuşuna basıyorum
toplam alanına kumanda satırından bakıyorum.

AutoCAD toplam alanları satırda gösteren lisp daha fazla ara

👀 google

👀 yandex

👀 bing

👀 youtube

👀 facebook

👀 wikipedia

👀 google kitap

👀 google trends

👀 uzmantv

👀 twitter

👀 pinterest

👀 eksisozluk

AutoCAD toplam alanları satırda gösteren lisp ilgili benzer konular

👀 AutoCAD çizgileri toplayan lisp

👀 AutoCAD polyline uzunluk ölçme

👀 AutoCAD metraj komutu

👀 AutoCAD metraj lisp

AutoCAD toplam alanları satırda gösteren lisp - Metraj Lispi

Hiç yorum yok:

🐄 Metraj Lispi 🐅 Alan-Çevre Lispleri lisp

👱 Çizimde bulunan birden fazla alan için, Her bir alanı numaralandırır ve alan tablosu oluşturur.

alanları numaralandırıp tabloya aktaran lisp

Autocad lisp kodlar

(defun c:ALAN-TABLO nil (AreaLabel   t))  ;; Areas to Table
(defun c:ALAN-DOSYA nil (AreaLabel nil))  ;; Areas to File

(defun AreaLabel ( flag / *error* _startundo _endundo _centroid _text _open _select _getobjectid _isannotative
                          acdoc acspc ap ar as cf cm el fd fl fo n of om p1 pf pt sf st t1 t2 tb th ts tx ucsxang ucszdir )

(setq h1 "Alan Tablosu"  ;; Heading
        t1 "No"      ;; Number Title
        t2 "Alan"        ;; Area Title
        pf ""            ;; Number Prefix (optional, "" if none)
        sf ""            ;; Number Suffix (optional, "" if none)
        ap ""            ;; Area Prefix (optional, "" if none)
        as ""            ;; Area Suffix (optional, "" if none)
        cf 1.0           ;; Area Conversion Factor (e.g. 1e-6 = mm2->m2)
        fd t             ;; Use fields to link numbers/objects to table (t=yes, nil=no)
        fo "%lu6%qf1"    ;; Area field formatting
  )

;;------------------------------------------------------------;;

(defun *error* ( msg )
    (if cm (setvar 'CMDECHO cm))
    (if el (progn (entdel el) (setq el nil)))
    (if acdoc (_EndUndo acdoc))
    (if (and of (eq 'FILE (type of))) (close of))
    (if (and Shell (not (vlax-object-released-p Shell))) (vlax-release-object Shell))
    (if (null (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
        (princ (strcat "\n--> Error: " msg))
    )
    (princ)
  )

;;------------------------------------------------------------;;

(defun _StartUndo ( doc ) (_EndUndo doc)
    (vla-StartUndoMark doc)
  )

;;------------------------------------------------------------;;

(defun _EndUndo ( doc )
    (if (= 8 (logand 8 (getvar 'UNDOCTL)))
      (vla-EndUndoMark doc)
    )
  )

;;------------------------------------------------------------;;

(defun _centroid ( space objs / reg cen )
    (setq reg (car (vlax-invoke space 'addregion objs))
          cen (vlax-get reg 'centroid)
    )
    (vla-delete reg) (trans cen 1 0)
  )

;;------------------------------------------------------------;;

(defun _text ( space point string height rotation / text )
    (setq text (vla-addtext space string (vlax-3D-point point) height))
    (vla-put-alignment text acalignmentmiddlecenter)
    (vla-put-textalignmentpoint text (vlax-3D-point point))
    (vla-put-rotation text rotation)
    text
  )

;;------------------------------------------------------------;;

(defun _Open ( target / Shell result )
    (if (setq Shell (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application"))
      (progn
        (setq result
          (and (or (eq 'INT (type target)) (setq target (findfile target)))
            (not
              (vl-catch-all-error-p
                (vl-catch-all-apply 'vlax-invoke (list Shell 'Open target))
              )
            )
          )
        )
        (vlax-release-object Shell)
      )
    )
    result
  )

;;------------------------------------------------------------;;

(defun _Select ( msg pred func init / e ) (setq pred (eval pred)) 
    (while
      (progn (setvar 'ERRNO 0) (apply 'initget init) (setq e (func msg))
        (cond
          ( (= 7 (getvar 'ERRNO))
            (princ "\nMissed, try again.")
          )
          ( (eq 'STR (type e))
            nil
          )            
          ( (vl-consp e)
            (if (and pred (not (pred (setq e (car e)))))
              (princ "\nInvalid Object Selected.")
            )
          )
        )
      )
    )
    e
  )

;;------------------------------------------------------------;;

(defun _GetObjectID ( doc obj )
    (if (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
      (vlax-invoke-method (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false)
      (itoa (vla-get-Objectid obj))
    )
  )

;;------------------------------------------------------------;;

(defun _isAnnotative ( style / object annotx )
    (and
      (setq object (tblobjname "STYLE" style))
      (setq annotx (cadr (assoc -3 (entget object '("AcadAnnotative")))))
      (= 1 (cdr (assoc 1070 (reverse annotx))))
    )
  )
  
  ;;------------------------------------------------------------;;

(setq acdoc (vla-get-activedocument (vlax-get-acad-object))
        acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace))

ucszdir (trans '(0. 0. 1.) 1 0 t)
        ucsxang (angle '(0. 0. 0.) (trans (getvar 'UCSXDIR) 0 ucszdir))
  )
  (_StartUndo acdoc)
  (setq cm (getvar 'CMDECHO))
  (setvar 'CMDECHO 0)
  (setq om (eq "1" (cond ((getenv "LMAC_AreaLabel")) ((setenv "LMAC_AreaLabel" "0")))))

(setq ts
    (/ (getvar 'TEXTSIZE)
      (if (_isAnnotative (getvar 'TEXTSTYLE))
        (cond ( (getvar 'CANNOSCALEVALUE) ) ( 1.0 )) 1.0
      )
    )
  )

(cond
    ( (not (vlax-method-applicable-p acspc 'addtable))

(princ "\n--> Table Objects not Available in this Version.")
    )
    ( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'CLAYER))))))

(princ "\n--> Current Layer Locked.")
    )
    ( (not
        (setq *al:num
          (cond
            (
              (getint
                (strcat "\nSpecify Starting Number <"
                  (itoa (setq *al:num (1+ (cond ( *al:num ) ( 0 ))))) ">: "
                )
              )
            )
            ( *al:num )
          )
        )
      )
    )
    ( flag

(setq th
        (* 2.
          (if
            (zerop
              (setq th
                (vla-gettextheight
                  (setq st
                    (vla-item
                      (vla-item
                        (vla-get-dictionaries acdoc) "ACAD_TABLESTYLE"
                      )
                      (getvar 'CTABLESTYLE)
                    )
                  )
                  acdatarow
                )
              )
            )
            ts
            (/ th
              (if (_isAnnotative (vla-gettextstyle st acdatarow))
                (cond ( (getvar 'CANNOSCALEVALUE) ) ( 1.0 )) 1.0
              )
            )
          )
        )
      )

(if
        (cond
          (
            (progn (initget "Add")
              (vl-consp (setq pt (getpoint "\nPick Point for Table <Add to Existing>: ")))
            )
            (setq tb
              (vla-addtable acspc
                (vlax-3D-point (trans pt 1 0)) 2 2 th (* 0.8 th (max (strlen t1) (strlen t2)))
              )
            )
            (vla-put-direction tb (vlax-3D-point (getvar 'UCSXDIR)))
            (vla-settext tb 0 0 h1)
            (vla-settext tb 1 0 t1)
            (vla-settext tb 1 1 t2)
            
            (while
              (progn
                (if om
                  (setq p1
                    (_Select (strcat "\nSelect Object [Pick] <Exit>: ")
                     '(lambda ( x )
                        (and
                          (vlax-property-available-p (vlax-ename->vla-object x) 'area)
                          (not (eq "HATCH" (cdr (assoc 0 (entget x)))))
                          (or (eq "REGION" (cdr (assoc 0 (entget x)))) (vlax-curve-isclosed x))
                        )
                      )
                      entsel '("Pick")
                    )
                  )
                  (progn (initget "Object") (setq p1 (getpoint "\nPick Area [Object] <Exit>: ")))
                )
                (cond
                  ( (null p1)

(vla-delete tb)
                  )
                  ( (eq "Pick" p1)

(setq om nil) t
                  )
                  ( (eq "Object" p1)

(setq om t)
                  )
                  ( (eq 'ENAME (type p1))

(setq tx
                      (cons
                        (_text acspc
                          (_centroid acspc (list (setq p1 (vlax-ename->vla-object p1))))
                          (strcat pf (itoa *al:num) sf)
                          ts
                          ucsxang
                        )
                        tx
                      )
                    )
                    (vla-insertrows tb (setq n 2) th 1)
                    (vla-settext tb n 1
                      (if fd
                        (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                          (_GetObjectID acdoc p1) ">%).Area \\f \"" fo "\">%"
                        )
                        (strcat ap (rtos (* cf (vla-get-area p1)) 2) as)
                      )
                    )
                    (vla-settext tb n 0
                      (if fd
                        (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                          (_GetObjectID acdoc (car tx)) ">%).TextString>%"
                        )
                        (strcat pf (itoa *al:num) sf)
                      )
                    )
                    nil
                  )                      
                  ( (vl-consp p1)

(setq el (entlast))
                    (vl-cmdf "_.-boundary" "_A" "_I" "_N" "" "_O" "_P" "" "_non" p1 "")

(if (not (equal el (setq el (entlast))))
                      (progn
                        (setq tx
                          (cons
                            (_text acspc
                              (_centroid acspc (list (vlax-ename->vla-object el)))
                              (strcat pf (itoa *al:num) sf)
                              ts
                              ucsxang
                            )
                            tx
                          )
                        )
                        (vla-insertrows tb (setq n 2) th 1)
                        (vla-settext tb n 1 (strcat ap (rtos (* cf (vlax-curve-getarea el)) 2) as))
                        (vla-settext tb n 0
                          (if fd
                            (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                              (_GetObjectID acdoc (car tx)) ">%).TextString>%"
                            )
                            (strcat pf (itoa *al:num) sf)
                          )
                        )
                        (redraw el 3)
                        nil
                      )
                      (vla-delete tb)
                    )
                  )
                )
              )
            )
            (not (vlax-erased-p tb))
          )
          (
            (and
              (setq tb
                (_Select "\nSelect Table to Add to: "
                 '(lambda ( x ) (eq "ACAD_TABLE" (cdr (assoc 0 (entget x))))) entsel nil
                )
              )
              (< 1 (vla-get-columns (setq tb (vlax-ename->vla-object tb))))
            )
            (setq n (1- (vla-get-rows tb)) *al:num (1- *al:num))
          )
        )
        (progn
          (while
            (if om
              (setq p1
                (_Select (strcat "\nSelect Object [" (if tx "Undo/" "") "Pick] <Exit>: ")
                 '(lambda ( x )
                    (and
                      (vlax-property-available-p (vlax-ename->vla-object x) 'area)
                      (not (eq "HATCH" (cdr (assoc 0 (entget x)))))
                      (or (eq "REGION" (cdr (assoc 0 (entget x)))) (vlax-curve-isclosed x))
                    )
                  )
                  entsel (list (if tx "Undo Pick" "Pick"))
                )
              )
              (progn (initget (if tx "Undo Object" "Object"))
                (setq p1 (getpoint (strcat "\nPick Area [" (if tx "Undo/" "") "Object] <Exit>: ")))
              )
            )
            (cond
              ( (and tx (eq "Undo" p1))

(if el (progn (entdel el) (setq el nil)))
                (vla-deleterows tb n 1)
                (vla-delete (car tx))
                (setq n (1- n) tx (cdr tx) *al:num (1- *al:num))
              )
              ( (eq "Undo" p1)

(princ "\n--> Nothing to Undo.")
              )
              ( (eq "Object" p1)

(if el (progn (entdel el) (setq el nil)))
                (setq om t)
              )
              ( (eq "Pick" p1)

(setq om nil)
              )
              ( (and om (eq 'ENAME (type p1)))

(setq tx
                  (cons
                    (_text acspc
                      (_centroid acspc (list (setq p1 (vlax-ename->vla-object p1))))
                      (strcat pf (itoa (setq *al:num (1+ *al:num))) sf)
                      ts
                      ucsxang
                    )
                    tx
                  )
                )
                (vla-insertrows tb (setq n (1+ n)) th 1)
                (vla-settext tb n 1
                  (if fd
                    (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                      (_GetObjectID acdoc p1) ">%).Area \\f \"" fo "\">%"
                    )
                    (strcat ap (rtos (* cf (vla-get-area p1)) 2) as)
                  )
                )
                (vla-settext tb n 0
                  (if fd
                    (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                      (_GetObjectID acdoc (car tx)) ">%).TextString>%"
                    )
                    (strcat pf (itoa *al:num) sf)
                  )
                )
              )               
              ( (vl-consp p1)

(if el (progn (entdel el) (setq el nil)))
                (setq el (entlast))
                (vl-cmdf "_.-boundary" "_A" "_I" "_N" "" "_O" "_P" "" "_non" p1 "")

(if (not (equal el (setq el (entlast))))
                  (progn
                    (setq tx
                      (cons
                        (_text acspc
                          (_centroid acspc (list (vlax-ename->vla-object el)))
                          (strcat pf (itoa (setq *al:num (1+ *al:num))) sf)
                          ts
                          ucsxang
                        )
                        tx
                      )
                    )
                    (vla-insertrows tb (setq n (1+ n)) th 1)
                    (vla-settext tb n 1 (strcat ap (rtos (* cf (vlax-curve-getarea el)) 2) as))
                    (vla-settext tb n 0
                      (if fd
                        (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                          (_GetObjectID acdoc (car tx)) ">%).TextString>%"
                        )
                        (strcat pf (itoa *al:num) sf)
                      )
                    )
                    (redraw el 3)
                  )
                  (princ "\n--> Error Retrieving Area.")
                )
              )
            )
          )
          (if el (progn (entdel el) (setq el nil)))
        )
      )
    )
    (
      (and
        (setq fl (getfiled "Create Output File" (cond ( *file* ) ( "" )) "txt;csv;xls" 1))
        (setq of (open fl "w"))
      )
      (setq *file*  (vl-filename-directory fl)
            de      (cdr (assoc (strcase (vl-filename-extension fl) t) '((".txt" . "\t") (".csv" . ",") (".xls" . "\t"))))
            *al:num (1- *al:num)
      )
      (write-line h1 of)
      (write-line (strcat t1 de t2) of)

(while
        (if om
          (setq p1
            (_Select (strcat "\nSelect Object [Pick] <Exit>: ")
             '(lambda ( x )
                (and
                  (vlax-property-available-p (vlax-ename->vla-object x) 'area)
                  (not (eq "HATCH" (cdr (assoc 0 (entget x)))))
                  (or (eq "REGION" (cdr (assoc 0 (entget x)))) (vlax-curve-isclosed x))
                )
              )
              entsel '("Pick")
            )
          )
          (progn (initget "Object") (setq p1 (getpoint (strcat "\nPick Area [Object] <Exit>: "))))
        )
        (cond
          ( (eq "Object" p1)

(if el (progn (entdel el) (setq el nil)))
            (setq om t)
          )
          ( (eq "Pick" p1)

(setq om nil)
          )
          ( (eq 'ENAME (type p1))

(_text acspc
              (_centroid acspc (list (setq p1 (vlax-ename->vla-object p1))))
              (strcat pf (itoa (setq *al:num (1+ *al:num))) sf)
              ts
              ucsxang
            )           
            (write-line (strcat pf (itoa *al:num) sf de ap (rtos (* cf (vla-get-area p1)) 2) as) of)
          )
          ( (vl-consp p1)
        
            (if el (progn (entdel el) (setq el nil)))
            (setq el (entlast))
            (vl-cmdf "_.-boundary" "_A" "_I" "_N" "" "_O" "_P" "" "_non" p1 "")

(if (not (equal el (setq el (entlast))))
              (progn
                (_text acspc
                  (_centroid acspc (list (vlax-ename->vla-object el)))
                  (strcat pf (itoa (setq *al:num (1+ *al:num))) sf)
                  ts
                  ucsxang
                )
                (write-line (strcat pf (itoa *al:num) sf de ap (rtos (* cf (vlax-curve-getarea el)) 2) as) of)
                (redraw el 3)
              )
              (princ "\n--> Error Retrieving Area.")
            )
          )
        )
      )
      (if el (progn (entdel el) (setq el nil)))
      (setq of (close of))
      (_Open (findfile fl))
    )      
  )
  (setenv "LMAC_AreaLabel" (if om "1" "0"))
  (setvar 'CMDECHO cm)
  (_EndUndo acdoc)
  (princ)
)

(vl-load-com)
(princ)
(princ "\n:: AreaLabel.lsp | Version 1.9 | © Lee Mac 2011 www.lee-mac.com ::")
(princ "\n:: Commands: \"AT\" for ACAD Table, \"AF\" for File ::")
(princ)

Autocad lisp çalıştırma

📜 Komut satırına "ALAN-TABLO" yazın ve enterlayın

📜Alan başlangıc numarası kaç olsun diye sorar.

Tıkladığınız her alan 1 2 3 4 5 diye ardişik olarak sıralanır.
İlk numara kaç olsun istiyorsanız onu yazın,
İstediğiniz sayıdan başlatabilirsiniz.
örnekte 1 yazıp enter tuşuna basıyorum

📜Pick point for table yazısı çıkacak.

tablonun nereye gelmesini istiyorsanız oraya tıklayın

📜Pick area yazacak.

Burada alanlara tıklayınız. Biraz dikkatli olmanız gerekir. çizginin üzerine değil alana tıklamanız gerekli
Şeklin alanına gittiğiniz zaman, şeklin ortasında yıldız işareti oluşur. tam oraya tıklayınız.

📜Tıklama sırasına göre alanlar numaralandırılır ve o numaralara göre alanlar tabloya yazılılır.

ilk karenin merkezine tıkladım kareye 1 denildi
Sonra üçgen merkezine tıkladım 2 yazıldı
Sonra dikdörtgen merkezine tıkladım 3 yazıldı
Sırası ile bu şekilde devam edildi.

alanları tabloya değilde başka bir dosyaya aktarmak için

📜 Komut satırına "ALAN-DOSYA" yazın ve enterlayın

📜Alanları ardışık olarak sıralanacak ilk sayıyı yazın

1 yazıp tıklıyorum

📜Dosyanın kaydedilecek yerini ve adını şeçin

Dosyayı excel (xls) olarak kaydedebilirsiniz
Dosyası not defteri (txt) olarak kaydedebilirsiniz
Dosya adını yazın
Nereye kadedeceğinizi seçin
Uzantısını seçin (excel veya not defteri)
Kaydet tıklayın

📜Şimdi yukarda olduğu gibi tek tek alanlara tıklayın ve enter tuşuna basın

Az önce olduğu gibi yine sırası ile kare, üçgen, dikdörtgen, çokgen, tıkladım
Enter tuşuna bastım
Kaydettiğiniz dosya açılacak

Autocad alanları numaralandırıp tabloya aktaran lisp daha fazla ara

👀 google

👀 yandex

👀 bing

👀 youtube

👀 facebook

👀 wikipedia

👀 google kitap

👀 google trends

👀 uzmantv

👀 twitter

👀 pinterest

👀 eksisozluk

Autocad alanları numaralandırıp tabloya aktaran lisp ilgili benzer konular

👀 autocad den excele tablo aktarma lisp

👀 autocad ölçülerini tabloya aktarma

👀 autocad mahal listesini excele aktarma

👀 autocad text to excel

👀 autocad lisp indir

👀 autocad excel bağlantısı

Autocad alanları numaralandırıp tabloya aktaran lisp - Metraj Lispi

Hiç yorum yok:
1 Mart 2021 Pazartesi

🐄 Metraj Lispi 🐅 Alan-Çevre Lispleri lisp

👱 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)
)

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.

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

Hiç yorum yok:
26 Şubat 2021 Cuma

🐃 Yazı Lispleri 🐄 Metraj Lispi lisp

Autocad lisp kodlar

Toplam alanı yazma

Toplam uzunluğu yazma lispi

Autocad lisp kodlar

AutoCAD iki nokta arasındaki uzunluğu yazan lisp resimli anlatım

AutoCAD iki nokta arasındaki uzunluğu yazan lisp daha fazla ara

AutoCAD iki nokta arasındaki uzunluğu yazan lisp ilgili benzer konular

Autocad lisp kodlar

Autocad lisp çalıştırma

Autocad lisp kodlar

Autocad lisp çalıştırma

📜Şimdi birden çok şeklin toplam alanını bulualım

AutoCAD toplam alanları satırda gösteren lisp daha fazla ara

AutoCAD toplam alanları satırda gösteren lisp ilgili benzer konular

Autocad lisp kodlar

Autocad lisp çalıştırma

alanları tabloya değilde başka bir dosyaya aktarmak için

Autocad alanları numaralandırıp tabloya aktaran lisp daha fazla ara

Autocad alanları numaralandırıp tabloya aktaran lisp ilgili benzer konular

Autocad lisp kodlar

Autocad lisp çalıştırma

Blog Arşivi