일괄면적 계산 리습관련 문의드립니다.
컨텐츠 정보
- 12 조회
- 5 댓글
- 0 추천
- 0 비추천
- 목록
본문
리습
면적
캐드
관련자료
penpen07님의 댓글
(defun c:aq ( / doc space n sum obj sp ep cplst area sum cdn mp v sa xp yp pt txtobj objname divlst memory *error*)
(vl-load-com)
(defun divlst (lst num / e blst lst newlst)
(while (setq e (car lst))
(repeat num
(if e (setq blst (cons e blst)))
(setq lst (cdr lst) e (car lst))
)
(setq newlst (append newlst (list (reverse blst))) blst nil)
)
newlst
)
(defun memory (msg bval mval / sval)
(if (equal mval nil)
(setq mval bval)
)
(setq sval (getint (strcat "n=== " msg " :")))
(if sval
(setq mval sval)
mval
)
)
(defun *error* (msg)
(if (/= msg "function cancelled")
(if (= msg "quit / exit abort")
(princ)
(princ (strcat "n=== error: " msg))
)
(princ)
)
(princ)
)
(setq doc (vla-get-activedocument(vlax-get-acad-object)))
(setq space (if (= (getvar "cvport") 1)(vla-get-paperspace doc)(vla-get-modelspace doc)))
(prompt "n>> 일괄 면적 구하기")
(if (not (setq ss (ssget '((0 . "lwpolyline,circle,ellipse,region")))))
(exit)
)
(setq $sn (memory "소수자리 입력" 2 $sn)) ;소수자리 기본값 변경시 2를 변경
(setq $tsz (memory "문자크기 입력" 10 $tsz)) ;문자크기 기본값 변경시 10을 변경
(setq n 0 sum 0 val (/ 2.0 3.0))
(repeat (sslength ss)
(setq obj (vlax-ename->vla-object (ssname ss n)))
(setq objname (vla-get-objectname obj))
(if (equal objname "AcDbPolyline")
(progn
(setq sp (vlax-curve-getstartpoint obj) ep (vlax-curve-getendpoint obj) cplst nil)
(if (equal (distance sp ep) 0 0.1)
(vla-put-closed obj :vlax-true)
)
(if (vlax-curve-isclosed obj)
(progn
(setq area (* (vla-get-area obj) 0.000001))
(if
(or
(= 0 (- area (fix area)))
(/= "0" (rtos (- area (fix area)) 2 $sn))
)
(setq area (rtos area 2 $sn))
(progn
(setq area (strcat (rtos area 2 $sn) "."))
(repeat $sn
(setq area (strcat area "0"))
)
)
)
(setq sum (+ sum (atof area)))
(setq cdn (append (cdr (divlst (vlax-get obj 'coordinates) 2)) (list sp)))
(foreach x cdn
(setq mp (polar sp (angle sp x) (/ (distance sp x) 2)))
(setq v (/ (- (* (car sp) (cadr x)) (* (cadr sp) (car x))) 2))
(setq cplst (append cplst (list (list (car mp) (cadr mp) v))) sp x)
)
(setq sa (apply '+ (mapcar '(lambda (x) (caddr x)) cplst)))
(setq xp (apply '+ (mapcar '(lambda (x) (* (car x) (/ (* (caddr x) val) sa))) cplst)))
(setq yp (apply '+ (mapcar '(lambda (x) (* (cadr x) (/ (* (caddr x) val) sa))) cplst)))
(setq pt (vlax-3d-point (list xp yp)))
(setq txtobj (vla-addtext space area pt $tsz))
(vla-put-alignment txtobj 4)
(vla-put-textalignmentpoint txtobj pt)
(vla-update txtobj)
)
)
)
(progn
(setq area (* (vla-get-area obj) 0.000001))
(if
(or
(= 0 (- area (fix area)))
(/= "0" (rtos (- area (fix area)) 2 $sn))
)
(setq area (rtos area 2 $sn))
(progn
(setq area (strcat (rtos area 2 $sn) "."))
(repeat $sn
(setq area (strcat area "0"))
)
)
)
(setq sum (+ sum (atof area)))
(if (equal objname "AcDbRegion")
(setq pt (vlax-3d-point (append (vlax-get obj 'centroid) (list 0.0))))
(setq pt (vla-get-center obj))
)
(setq txtobj (vla-addtext space area pt $tsz))
(vla-put-alignment txtobj 4)
(vla-put-textalignmentpoint txtobj pt)
(vla-update txtobj)
)
)
(setq n (1+ n))
)
(if (/= sum 0)
(if (setq pt (getpoint "n=== 면적 합계를 표시할 곳 지정:"))
(progn
(setq sum (rtos sum 2 $sn))
(if (not (vl-string-search "." sum))
(progn
(setq sum (strcat sum "."))
(repeat $sn
(setq sum (strcat sum "0"))
)
)
)
(vla-addtext space sum (vlax-3d-point pt) $tsz)
)
)
)
(princ)
)
게시판 기능이 미비하기 때문에 코드를 그냥 복사해서 사용하면, 안될겁니다. 줄바꿈 문자에서 역슬래쉬가 표기되지 않으므로, 쌍따옴표 안의 n 앞에 역슬래쉬를 찍어야 할거예요. 그리고 쌍따옴표도 다른 기호로 들어가는 경우가 있으므로, 특수문자로 들어간 쌍따옴표를 다시 찍어야 할겁니다. 한글이 포함되어 있으므로, 저장할 때에 ANSI 양식으로 저장하세요.