리습 - 전체 Block list를 txt 및 dwg로 내보내기
본문 바로가기
■ 유용한 캐드&리습/▫ AutoLISP

리습 - 전체 Block list를 txt 및 dwg로 내보내기

by 아키모아 주말농부 2024. 12. 20.
728x90

;=============================
; Block list를 txt 및 dwg로 내보내기 (2020.7 주말농부)
; ->1. 작업폴더에 dwg화일명.txt를 생성해주고
; ->2. 내부블록을 외부dwg파일로 생성하는 리습
;------- Block list Txt & Dwg -------------
(defun c:btd(/ bed1 bed2 bst1 bst2 bst-lst  path npath bla_wr1 n bst dname)
  (setq bed1 (tblnext "block" t))
  (setq bst1 (cdr (assoc 2 bed1)));block name
  (setq bst-lst (list bst1))
  (setq bed2 (tblnext "block"))
  (while bed2
      (setq bst2 (cdr (assoc 2 bed2)));block name
      (if (or (= (cdr (assoc 70 bed2)) 0) (= (cdr (assoc 70 bed2)) 2))
        (setq bst-lst (cons bst2 bst-lst))
      )
      (setq bed2 (tblnext "block"))
  )
  (setq bst-lst (vl-sort bst-lst '<)) (prin1 bst-lst)
;->txt파일 만들기
  (setq dname (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4)))
  (setq path (strcat (getvar "dwgprefix") dname ".txt"))
  (setq bla_wr1 (open path "w"))
  (setq n 0)
  (repeat (length bst-lst)
    (setq bst (nth n bst-lst))
    (write-line bst bla_wr1)
    (setq n (+ n 1))
  )
  (close bla_wr1)
;->외부 dwg만들기
  (setq n 0)
  (repeat (length bst-lst)
    (setq bst (nth n bst-lst))
    (setq npath (strcat (getvar "dwgprefix") bst ".dwg"))
    (if (= (vl-file-size npath) nil) (command "wblock" npath bst)  );기존화일 유무확인
    (setq n (+ n 1))
  )
 (prompt "\n ---> 총 블록갯수 : ")(prin1 n) (prompt "개")
(prin1))
 

block list를 txt 및 dwg로 내보내기-btd.lsp
0.00MB
728x90