Lisp gộp file dwg miễn phí | IMF by Nguyen Hoanh | AutoLISP Reviewer

Ứng dụng được Sưu tầm bởi đội ngũ AutoLISP Thật là đơn giản

   

Thông tin thêm: 👉👉👉

Lệnh Gộp file IMF 

Thực hiện lệnh IMF, chọn tệp tin dwg đầu tiên trong thư mục.

Tác giả: Anh Nguyen Hoanh

1 Thêm class IMF_.lsp

Lưu mã sau dưới dạng tệp tin IMF_.lsp

Code:

(defun c:imf () ;;;Insert Multi Files by Nguyen Hoanh ( bo tat ca ban ve vao 1 file rieng, roi nhan lenh, chon ban ve dau tien )
  (setq pathname (vl-filename-directory
                   (getfiled "Hay chon file dwg bat ky thuoc thu muc" "" "dwg" 0)
                   )
        filelist (vl-sort (vl-directory-files pathname "*.dwg") '<)
        p        (getpoint "\nDiem chen: ")
        xht      (car p)
        yht      (cadr p)
        )
  (setq oldos (getvar "osmode"))
  (setvar "osmode" 0)
  (foreach filename filelist
    (command "-insert"
             (strcat pathname "/" filename)
             (list xht yht)
             1.0
             1.0
             0.0
             )
    (vla-getboundingbox
      (vlax-ename->vla-object (entlast))
      'p1
      'p2
      )
    (setq p1     (vlax-safearray->list p1)
          p2     (vlax-safearray->list p2)
          xht    (+ xht (abs (car (mapcar '- p2 p1))))
          blname (cdr (assoc 2 (entget (entlast))))
          )
    (command ".explode" (entlast) "")
    (command "-purge" "Block" blname "N")
    )
  (setvar "osmode" oldos)
  (princ)
  )

(defun c:exf () ;;;EXtract Files by Nguyen Hoanh
  (defun filenamevalid (str)
    (vl-list->string
      (vl-remove-if
        '(lambda (x) (member x (vl-string->list "\\/:?>|")))
        (vl-string->list str)
        )
      )
    )
  (defun getboundingbox (ent / p1 p2)
    (vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
    (list (setq p1 (vlax-safearray->list p1))
          (setq p2 (vlax-safearray->list p2))
          )
    )
  (defun ss2ent (ss / sodt index lstent)
    (setq sodt  (if ss
                  (sslength ss)
                  0
                  )
          index 0
          )
    (repeat sodt
      (setq ent    (ssname ss index)
            index  (1+ index)
            lstent (cons ent lstent)
            )
      )
    (reverse lstent)
    )
  (defun dxf (ent code) (cdr (assoc code (entget ent))))
  (defun gettag (ent / entbl lst)
    (setq entbl ent)
    (while (and (setq entbl (entnext entbl))
                (= (dxf entbl 0) "ATTRIB")
                )
      (setq lst (append lst (list (cons (dxf entbl 2) (dxf entbl 1)))))
      )
    lst
    )
  (setq entbl  (car (entsel "\nHay pick vao block khung ten"))
        blname (dxf entbl 2)
        taglst (gettag entbl)
        index  0
        )
  (princ "\nCac tag trong block:")
  (foreach pp taglst
    (princ (strcat "\n" (itoa index) ": " (car pp)))
    (setq index (1+ index))
    )
  (textscr)
  (setq
    tag (car
          (nth (getint "\nHay nhan 0,1,2... de chon tag: ") taglst)
          )
    )
  (graphscr)
  (command ".zoom" "e")
  (setq oldos (getvar "osmode"))
  (setvar "osmode" 0)
  (setq ss  (ssget "x" (list (cons 0 "INSERT") (cons 2 blname)))
        lst (ss2ent ss)
        lst (mapcar '(lambda (e)
                       (append (list e (cdr (assoc tag (gettag e))))
                               (getboundingbox e)
                               )
                       )
                    lst
                    )
        )
  (foreach pp lst
    (setq e  (nth 0 pp)
          f  (strcat (getvar "dwgprefix")
                     (filenamevalid (nth 1 pp))
                     ".dwg"
                     )
          p1 (nth 2 pp)
          p2 (nth 3 pp)
          ss (ssget "_w" p1 p2)
          ss (ssadd e ss)
          )
    (command ".wblock" f)
    (if (setq fh (open f "r"))
      (progn (close fh) (command "y"))
      )
    (command "" p1 ss "")
    (command ".oops")
    )
  (setvar "osmode" oldos)
  (command ".zoom" "p")
  (princ)
  )

Link tải (MediaFire)

📥 https://www.mediafire.com/

---------------------------------------------------------------------------------------------

Ứng dụng được phát triển bởi đội ngũ AutoLISP Thật là đơn giản - Tác giả ứng dụng in D2P

    

Mọi thông tin xin liên hệ Fanpage AutoLISP Thật là đơn giản!

Cảm ơn bạn đã theo dõi!