Fix Scale Exported DWG from rvt

FixExportedDWG.lsp

0.00MB

;; 드디어 완료함. ^___^ 20240627.
;; 레빗에서 추출한 DWG의 시트는 배치탭, 작도는 모형탭에 보임.
;; 배치탭을 모형탭으로 추출하면 1:1로 작아지는데
;; 1:100 도면을 100배 확대하면 길이는 정상이지만 치수가 모조리 문제.
;; 이걸 해결하기 위해서 그동안 개발했는데, 문제는 한가지 치수스타일로만
;; 조정된다는 거임.
;; 이제 모든 치수유형에 초록색 문자와 숫자 크기를 3mm로 적용할 수 있음.
;; 시트 선택 없이 알아서 원점배치, 스케일 찾아서 확대 함. 오토스크립트 적용 가능.
;; 시트블록이름을 변수에 지정 (setq SheetBlockName "Sheet_Y1*") on 20260130
;; 스케일 값이 "MTEXT" 인 경우, 파싱해서 스케일 값만 추출 on 20260130

(defun KM:setINI ( / )
(progn 
(setq _dimFont "돋움") ;; 치수 폰트 지정 
(setq _cadDimstyle "SK_돋움_3") ; 치수스타일 지정 
(setq _scale 1.0)
(setq _sclPosition '(770.0 64.0)) ;;coordination(SK titleblock) of the string "A1: 1/400" of scale of the drawing 
(setq SheetBlockName "Sheet_YI*")
(setq scl 1.0)
(princ) 
))
;  
(defun KM:getscl ( / pt1 sclobj txtstr sclpos);; find scale factor  
(command "zoom" "e")  ;;
;;(command "explode" (ssget _sclPosition)) 
;;(command "explode" (ssget _sclPosition))
(setq sclobj (entget (ssname (ssget _sclPosition) 0) )) ;get entity zero from prop.  
;;(command "undo" 2) 
(setq scl (cdr (assoc 1 sclobj))) ;get list containing string  
(setq sclpos (vl-string-search "/" scl))  ; 08.85714,112.48571,116.11429;{1/700} 에서 {1 "/" 위치
(setq scl (substr scl (+ 2 sclpos)))  ; set scl "700}"
;; addtional get scale function for the Y1 project on 20260130
;; if scl is mtext "08.85714,112.48571,116.11429;{1/700}" , extract str scale "700"
(if (eq (cdr (assoc 0 sclobj)) "MTEXT")
    (setq scl (vl-string-subst "" "}" scl))  ; delete "}"; replace "}" to ""
    (print scl)
)
;;
(setq scl (atof scl))  ; conv string of scl to real scale
(print scl)
) 
;  
(defun KM:df0 ( dimfont );; set font-height to zero ;  
(progn  
(vl-load-com)  
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))  
(setq StyList (vla-get-TextStyles ActDoc))  
(setq StyObj (vla-Item StyList dimFont))  
(vla-put-Height StyObj 0.0)  
(princ)  
))
;
(defun KM:set_DIMSTYLE ( dimFont cadDimstyle dscale);;modifying dimstyle of the SK_돋움_3  
(progn 
(command "-dimstyle" "r" cadDimstyle) 
(setvar "DIMSCALE" dscale) ; Set dimscale
(setvar "DIMEXO" 3.0) ; Lines. Offset from origin 3.0 
(setvar "DIMASZ" 1.0) ; Symbols and Arrows. Arrow size 1.0 
(setvar "DIMBLK" "_DOTBLANK") ; Symbols and Arrows. Arrowhead 
(setvar "DIMCLRT" 3)
(setvar "DIMTXSTY" dimFont) ; Text. Text style 
(setvar "DIMTXT" 3.0) ; Text. Text Height 2.9 
(setvar "DIMTAD" 1) ; Text. Text placement Vertical Above(1) 
(setvar "DIMGAP" 1.0) ; Text. Offset from dim line 1.0 
(setvar "DIMTIH" 0) ; Text. Aligned with dimension line 
(setvar "DIMTMOVE" 2) ; Fit. Text placement without leader 
(setvar "DIMTIX" 1) ; Fit. Always keep text between ext lines 
(setvar "DIMTOFL" 1) ; Fit. Draw dim line between ext lines 
(setvar "DIMDEC" 0.0) ; Primary Units. Linear dimensions Precision 0.0 
(setvar "DIMLUNIT" 6) ; Primary Units. Windows Desktop(6) 
(command "-dimstyle" "s" cadDimstyle "y") 
(command "_dimstyle" "a" "all" "") 
(command "regen") 
(princ) 
))  
;;;;
(defun c:RS( ) ;; main code set Scale>Dim>Fix RELOCATION SHEET_A1 ;
(KM:setINI);
(setvar "CMDECHO" 0) 
(KM:moveNscaleSheet) ;; relocation to origin ; 
(progn 
(setq _scale (KM:getscl)) ;; get scale 
(if (= _scale 0.0) 
(setq _scale 1.0) 
) 
(command ".scale" "all" "" '(0 0) _scale) ;; set scale 
(command "zoom" "e") 
)
; 
(KM:df0 _dimfont) ;; set font-height to zero 
;;(KM:set_DIMSTYLE _dimfont _cadDimstyle _scale) ;; set dimstyle 
;;SET ALL DIMSTYLES exceped Dimstyles Annotative, Standard.
(progn
(setq !Dimstyle (tblnext "DIMSTYLE" T)) ;;tblnext로 모든 치수유형 찾기
(while !Dimstyle
(setq !Dimstyle (cdr (assoc 2 !Dimstyle)))
(if 
(and (/= !Dimstyle "Annotative") (/= !Dimstyle "Standard")) ;;치수유형 중 주석형, 표준형은 제외.
(KM:set_DIMSTYLE _dimfont !Dimstyle _scale) )
(setq !Dimstyle (tblnext "DIMSTYLE"))
)
)
;;
;; REPEAT PROCESS ;; 반복작업 추가
(progn
   (command "-layer" "off" "A-ANNO-NPLT" "") 
)
;;
;;
(setvar "CMDECHO" 1) 
(princ) 
)
;;;; end_Main_code
;;
(defun KM:moveNscaleSheet ( / p0 p1 p2) ;; export Layout 파일을 0,0 1:1로 재배치
(vl-load-com)  
(setq p0 '(0 0)) 
;;(setq SheetBlockName "Sheet_A1*")
(setq SheetBlockName "Sheet_YI*")
;; SheetBlockName 도각 블럭을 찾아 좌표 획득. 원점으로 이동, 1:1로 스케일 초기화
(vla-GetBoundingBox (vlax-ename->vla-object
    (SSNAME (SSGET "A" (list (cons 0 "INSERT") (cons 2 SheetBlockName))) 0)
)
(setq p1 (vlax-safearray->list MinPt)) 
(setq p2 (vlax-safearray->list MaxPt)) ;;upper right point 
(setq p2 (list (car p2) (cadr p1) 0.0)) ;;lower right point
(command "move" "all" "" p1 "non" p0) 
(command "scale" "p" "" p0 (/ 841.0 (distance p1 p2)))
(princ)
) ; ;