비밀번호를 잊으셨나요?

비밀번호를 잊으셨나요? 비밀번호를 재설정하려면 이메일 주소를 입력해주세요.

계정이 있나요? 로그인

You must login to ask a question.

비밀번호를 잊으셨나요?

아직 계정이 없으신가요? 회원가입 하기

해당 질문을 신고하는 이유를 간단히 입력해주세요.

해당 답변을 신고하는 이유를 간단히 입력해주세요.

해당 유저를 신고하는 이유를 간단히 입력해주세요.

로그인회원가입

고캐드 – 캐드(CAD) 정보의 중심

고캐드 – 캐드(CAD) 정보의 중심 Logo 고캐드 – 캐드(CAD) 정보의 중심 Logo

고캐드 – 캐드(CAD) 정보의 중심 Navigation

  • Q&A
    • AutoCAD & CADian
    • Inventor & Solidworks
    • Revit & ArchiCAD
    • 자유질문
    • 기타
  • 커뮤니티
    • 오늘의이슈
    • 자유게시판
    • 익명게시판
    • 건의게시판
  • 자료실
    • 자료요청
    • 일반파일
    • 도면샘플
    • 유틸리티
    • 기타
  • 작품 갤러리
    • 그래픽
    • 캐드도면
    • 3D모델
    • 기타
  • 뉴스&이벤트
    • 공지사항
    • 뉴스
    • 전시/행사
    • 이벤트
    • 기타
검색
질문하기

Mobile menu

닫기
질문하기
  • 홈
  • 카테고리
    • AutoCAD & CADian
    • Inventor & Solidworks
    • Revit & ArchiCAD
    • 자유질문
    • 기타
  • 투표
  • 커뮤니티 그룹
  • Q&A
    • AutoCAD & CADian
    • Inventor & Solidworks
    • Revit & ArchiCAD
    • 자유질문
    • 기타
  • 커뮤니티
    • 오늘의이슈
    • 자유게시판
    • 익명게시판
    • 건의게시판
  • 자료실
    • 자료요청
    • 일반파일
    • 도면샘플
    • 유틸리티
    • 기타
  • 작품 갤러리
    • 그래픽
    • 캐드도면
    • 3D모델
    • 기타
  • 뉴스&이벤트
    • 공지사항
    • 뉴스
    • 전시/행사
    • 이벤트
    • 기타
홈/ 질문/Q 184757
다음
진행 중
익명
익명
등록일: 2023-05-122023-05-12T16:52:16+09:00 2023-05-12T16:52:16+09:00카테고리: AutoCAD & CADian

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

제가 쓰고 있는 면적 계산 리습인데요.. 소수점을 마음대로 정할 수 있지만 4자리로 정했을때
다른 면적은 소수점 4자리수로 잘 나오지만, 특정 면적이 4.00003일 경우 결과값은 4라고만 나와서요.
혹시 4.0000으로 나오게 하려면 무엇을 수정해야하나요?
(defun c:aq ( / doc space n sum obj sp ep cplst area sum cdn mp v sa xp yp pt txtobj objname)
(vl-load-com)
(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 “소수자리 입력” 4 $sn))  ;소수자리 기본값 변경시 2를 변경
(setq $tsz (memory “문자크기 입력” 500 $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 (rtos (* (vla-get-area obj) 0.000001) 2 $sn))
(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 (rtos (* (vla-get-area obj) 0.000001) 2 $sn))
(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)
)
)
autocad리습면적캐드
  • 1
  • 5 5 답변
  • 126 조회
공유
  • Facebook

    관련 있는 질문들

    • 캐드에서 복사해서 방향 옮길때 다른방향으로 가요.
    • 캐드에서 복사해서 방향 옮길때 다른방향으로 가요.
    • FAQ 51을 참조 하라는데 FAQ가 어디에 있나요??
    • jsk.shx 파일 받을 부탁드립니다 ㅠ

    답변을 남겨주세요
    응답 취소

    답변을 등록하기 위해서는 로그인이 필요합니다.

    비밀번호를 잊으셨나요?

    아직 계정이 없으신가요? 회원가입 하기

    5 답변

    • 작성 순
    • 최신 순
    • 공감 순
    1. aalan
    2. penpen07 Lv.23
      2023-05-14T02:40:13+09:00답변 등록 답변 등록 일시 2023-05-14 2:40 am

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

      • 0
      • 댓글 달기
      • 공유
        공유
        • 공유 Facebook
        • 공유 Twitter
      • JSW CH Lv.0
        2023-05-15T07:59:36+09:00에게 댓글을 달았습니다. 답변 등록 일시 2023-05-15 7:59 am

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

        • 0
        • 댓글 달기
        • 공유
          공유
          • 공유 Facebook
          • 공유 Twitter
    3. JSW CH Lv.0
      2023-05-15T08:00:14+09:00답변 등록 답변 등록 일시 2023-05-15 8:00 am
      (defun c:aq ( / doc space n sum obj sp ep cplst area sum cdn mp v sa xp yp pt txtobj objname)
      (vl-load-com)
      (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 (rtos (* (vla-get-area obj) 0.000001) 2 $sn))
      (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 (rtos (* (vla-get-area obj) 0.000001) 2 $sn))
      (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>> 면적 합계를 표시할 곳 지정:”))
      (vla-addtext space (rtos sum 2 $sn) (vlax-3d-point pt) $tsz)
      )
      )
      (princ)
      )
      (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 ” <” (rtos mval 2 0) “>:”)))
      (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)
      )
      • 0
      • 댓글 달기
      • 공유
        공유
        • 공유 Facebook
        • 공유 Twitter
      • penpen07 Lv.23
        2023-05-15T22:38:40+09:00에게 댓글을 달았습니다. 답변 등록 일시 2023-05-15 10:38 pm
        (수정됨)

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

        • 0
        • 댓글 달기
        • 공유
          공유
          • 공유 Facebook
          • 공유 Twitter
        • JSW CH Lv.0
          2023-05-16T15:30:06+09:00에게 댓글을 달았습니다. 답변 등록 일시 2023-05-16 3:30 pm

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

          • 0
          • 댓글 달기
          • 공유
            공유
            • 공유 Facebook
            • 공유 Twitter

    Sidebar

    질문하기
    공지사항

    • AI CAD의 미래! 캐디안 2025 1+1 프로모션 안내 2025-05-14

    Adv 234x60

    aalan

    Adv 234x60

    aalan

    Adv 120x600

    aalan

    Explore

    • 홈
    • 카테고리
      • AutoCAD & CADian
      • Inventor & Solidworks
      • Revit & ArchiCAD
      • 자유질문
      • 기타
    • 투표
    • 커뮤니티 그룹
    aalan

    Footer

    Support

    • 회사 및 서비스 소개
    • 자주 묻는 질문
    • 문의하기

    Guide

    • 제휴/협업 안내
    • 광고 서비스 안내

    Policy

    • 서비스 이용약관
    • 개인정보 처리방침
    • 광고성 정보 수신 동의

    Contents

    • 고밍스토리
    • 리습 시리즈

    정소프트 | 사업자등록번호 : 677-40-00198 | 대표 : 정은숙 | 이메일 : gocad.manager@gmail.com
    주소 : 서울특별시 강서구 양천로 400-12, 6층 614,615,617호(등촌동, 더리브골드타워)
    Copyright. 2012-2024 GOCAD All rights reserved

    링크 삽입/편집

    대상 URL을 입력하세요

    또는 기존의 콘텐츠에 링크

      검색어가 지정되지 않았습니다. 최근 항목 표시 검색하거나 위와 아래 화살키를 이용하여 항목을 선택하세요.