;=============================
; 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))
'■ 유용한 캐드&리습 > ▫ AutoLISP' 카테고리의 다른 글
각도가 같은 선만 추출하기 (0) | 2024.12.31 |
---|---|
리습 - 모든레이어 화면에 목록 만들기 (0) | 2024.12.31 |
리습 - 전체 Block list를 txt로 내보내기 (0) | 2024.12.20 |
리습 - 락걸린리습 원키 바꾸기 (0) | 2024.12.20 |
리습 - 리습으로 원키 바꾸기 (0) | 2024.12.20 |