DSUM : 치수만 합계
TSUM : 문자만 합계
DTSUM : 치수, 문자 합계
현재 문자처리 조건은 아래와 같습니다.
1. 다중문자를 일반문자 형식으로 변환하여 처리
2. 문자에서 숫자만 분리
3. 분리된 숫자 중 첫 번째 숫자만 적용
아임피러 님이 조언주신 내용와 같이 문자나 다중문자일 경우에는 조건이 까다롭습니다
다음에는 다른분들처럼 샘플도면이나 조건을 정해주세요.
아무것도 없으면 작성하기 힘들어요~~~~~~
;; 멀티 텍스트 문자열 추출 함수
(defun $MTextString->List (str / bcod scod est unicod)
(setq bcod 0 scod 0)
(foreach x (vl-string->list str)
(cond
((= x 92)
(and (minusp bcod) (setq est (cons 92 est)))
(setq bcod (~ bcod))
(or (zerop (logand scod 1)) (setq scod (+ scod 3) est (cdr est)))
)
((or (zerop bcod) (= (logand scod 2) 2))
(if (and (= (logand scod 4) 4) (= x 125))
(setq scod (- scod 4))
(and
(setq est (cons x est))
(or (zerop (logand scod 1)) (setq scod (1- scod)))
)
)
(and (= x 123) (setq scod (1+ scod)))
(and (= x 59) (= (logand scod 2) 2) (setq bcod (1- bcod) scod (- scod 2) est (cdr est)))
(and (= x 94) (= (logand scod 2) 2) (setq est (cons 47 (cdr est))))
)
((minusp bcod)
(if (wcmatch (chr x) ".")
(setq bcod (~ bcod) est (cons x est))
(if (member x '(80 112)) (setq bcod (~ bcod) est (append '(10 13) est)) (setq bcod (abs bcod)))
)
(and (member x '(83 115)) (setq scod (+ scod 2)))
(and (= x 85) (setq unicod T))
)
((= x 59) (setq bcod (1- bcod)))
(unicod (setq unicod nil)
(and (= x 43) (zerop (setq bcod (1- bcod))) (setq est (append '(43 85 92) est)))
)
)
) (reverse est)
)
;; 문자 텍스트에서 숫자를 추출
;; ($XText_Number <텍스트> <숫자 위치>)
;; 숫자 위치: nil=첫번째, -1=마지막, 0이상=해당위치
(defun $XText_Number (str pos / buff mpa mpb num_lst)
(foreach x ($MTextString->List str)
(or
(= x 44)
(and
(< 47 x 58)
(or
(and buff (setq buff (+ (* buff mpa) (* (- x 48) mpb)) mpb (* mpb mpb)))
(setq mpa 10 mpb 1 buff (- x 48))
)
)
(and (= x 46) (setq mpa 1 mpb 0.1))
(and buff (setq num_lst (cons buff num_lst) buff nil))
)
)
(and buff (setq num_lst (cons buff num_lst)))
(or (setq num_lst (reverse num_lst)) (setq num_lst '(nil)))
(if (numberp pos) (if (minusp pos) (last num_lst) (nth pos num_lst)) (car num_lst))
)
;; 텍스트 합 메인 함수
;; $Mod: 0 = 치수만, 1 = 텍스트만, 2 = 치수+텍스트
;; $Prec: rtos 함수 출력 정밀도
(defun $SUMDimensionText_main ($Mod $Prec / *error* acDoc ss i en ob nst pt txt)
(vl-load-com)
(defun *error* (msg)
(vla-endundomark (vla-get-ActiveDocument (vlax-get-acad-object)))
(or (wcmatch (strcase msg) "*취소*,*CANCEL*,*QUIT*,*EXIT*") (prompt (strcat "\nError: " msg "\n")))
(princ)
)
(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq acBlk (vla-get-Blocks acDoc))
(vla-startundomark acDoc)
(setq ss
(ssget
(cond
((= $Mod 2) '((0 . "DIMENSION,*TEXT")))
((= $Mod 1) '((0 . "*TEXT")))
(T '((0 . "DIMENSION")))
)
)
)
(or ss (prompt "\n객체가 선택되지 않았습니다.") (quit))
(repeat (setq i (sslength ss))
(setq i (1- i) en (ssname ss i) ob (vlax-ename->vla-object en))
(or
(and
(wcmatch (vlax-get ob 'ObjectName) "*Text")
(setq nst (cons ($XText_Number (vlax-get ob 'TextString) 0) nst))
)
(and
(wcmatch (vlax-get ob 'TextOverride) "*<>*,")
(setq nst (cons (vlax-get ob 'Measurement) nst))
)
(setq nst (cons ($XText_Number (vlax-get ob 'TextOverride) 0) nst))
)
(or (car nst) (ssdel en ss))
)
(setq nst (vl-remove 'nil nst))
(prompt (strcat "\n객체 수: " (rtos (sslength ss) 2 0) " \t합계: " (rtos (apply '+ nst) 2 $Prec)))
(initget 1)
(setq pt (getpoint "\n텍스트 삽입점 지정: "))
(setq txt
(strcat
(rtos (car nst) 2 $Prec)
(apply 'strcat (mapcar (function (lambda (num) (strcat "+" (rtos num 2 $Prec)))) (cdr nst)))
"="
(rtos (apply '+ nst) 2 $Prec)
)
)
(vla-AddText (vla-get-ModelSpace acDoc) txt (vlax-3d-point pt) (getvar 'TEXTSIZE))
(princ "\n합계 문자 작성이 완료되었습니다.")
(vla-endundomark acDoc)
(princ)
)
;; ($SUMDimensionText_main <모드> <출력 정밀도>)
;; 명령 연결 함수 1 / 치수 객체만 합계
(defun c:DSUM nil (prompt "DIMSUM\n합계를 구할 치수 객체 선택...") ($SUMDimensionText_main 0 0))
;; 명령 연결 함수 2 / 문자 객체만 합계
(defun c:TSUM nil (prompt "TEXTSUM\n합계를 구할 문자 객체 선택...") ($SUMDimensionText_main 1 0))
;; 명령 연결 함수 3 / 치수,문자 객체 합계
(defun c:DTSUM nil (prompt "DIMTEXTSUM\n합계를 구할 치수, 문자 객체 선택...") ($SUMDimensionText_main 2 0))