프로그램
리습 분류

면적리습 수정 부탁드립니다. 꾸벅! (단위나 글 없이 그냥 면적만, 숫자만 나오게요!)

컨텐츠 정보

  • 163 조회
  • 2 댓글
  • 0 추천
  • 0 비추천
  • 목록

본문

리습 전혀 몰라요. 만질줄도 건들줄도..

선배님들 면적 리습에 평이랑 m2 나오는데 이런거 다 지우고 오로지 숫자만 나왔으면 좋겠습니다.
그리고 이왕이면 소수점 버림 말고 올림으로요. 이건 중요하지 않아요!
부탁드리겠습니다
(defun c:aaa (/ doc space ss index obj mi mx minpt maxpt inspt area txtobj)
  (setvar "cmdecho" 0)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (cond
((= (vla-get-activespace doc) 1) (setq space (vla-get-modelspace doc)))
((= (vla-get-activespace doc) 0) (setq space (vla-get-paperspace doc)))
  )
  (if (setq ss (ssget (list (cons 0 "CIRCLE,ARC,*POLYLINE,LINE,ELLIPSE,SPLINE"))))
(if (or (setq ts (getreal (strcat "n텍스트 높이 입력 <" (vl-princ-to-string (getvar "textsize")) ">:")))
(setq ts (getvar "textsize"))
)
  (progn
(setvar "textsize" ts)
(setq index 0)
(repeat (sslength ss)
  (setq obj (vlax-ename->vla-object (ssname ss index)))
  (vla-getboundingbox obj 'mi 'mx)
  (setq minpt (vlax-safearray->list mi)
maxpt (vlax-safearray->list mx)
  )
  (setq inspt (polar minpt (angle minpt maxpt) (/ (distance minpt maxpt) 2)))
  (setq inspt (list (car inspt) (+ (cadr inspt) (* ts 2))))
  (setq area (vla-get-area obj)
len (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj))
  )
  (mapcar '(lambda (a b)
(setq p (vlax-3d-point inspt))
(setq txtobj (vla-addtext space (strcat a b) p ts))
(vla-put-alignment txtobj 4)
(vla-put-textalignmentpoint txtobj p)
(setq inspt (polar inspt (/ (* 270 pi) 180) (* ts 2)))
   )
  (list (rtos (/ area 1000000.0) 2 1))
  '("㎡") ; (rtos len 2 2))
  )
  (setq index (1+ index))
)
;;(command "chprop" (ssget "x" '((0 . "TEXT") (1 . "평*"))) "" "") ; "" "c" "7″ "")
  )
)
  )
  (princ)
)
(vl-load-com)
(prompt "n[ AAA ]")
(princ)

관련자료

댓글 2

궁금^^님의 댓글

완전 감동입니다. 선배님!!

잘 쓰겠습니다!! 복받으세용~~
여분필드1 여분필드2 여분필드3
전체 7,152 / 15 페이지
번호
제목
이름
알림 0