일괄면적 계산 리습관련 문의드립니다.

감사합니다!! 좋은 하루 보내세요~~

(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 양식으로 저장하세요.

아 넵 죄송합니다. 댓글로 올릴게요!

일부만 올리시면 수정을 못해요