2011상위버전에서 면적이 에러납니다.
곡선으로 pl라인 딴 면적은 실제면적과 다르게 나옵니다
수정부탁들요 ㅠㅠㅠ
(defun c:har ( / textpoint_ main_
a tpx0 tpx1 tpx2 tpx3)
(defun *error* ()
(princ “n ERROR ! Quit of program …”)
(princ “n”)
)
(defun textpoint_ ()
(if (or (= th2 0) (= th2 nil) (= ls2 0) (= ls2 nil)) (setq th2 3 ls2 4))
(initget 1)
(setq a (getpoint “nStart point:” ))
(initget (+ 1 2 3 ))
(setq th (getdist a (strcat “nHight of text <” (rtos th2) “>: “)))
(if (= th nil) (setq th th2))
(setq th2 th)
(initget 2)
(setq ls (getdist a (strcat “nSpacing of line <” (rtos ls2) “>: “)))
(if (= ls nil) (setq ls ls2))
(setq ls2 ls)
(setq tpx0 (car a))
(setq tpx1 (+ (car a) (* th 10.0)))
(setq tpx2 (+ (car a) (* th 18.0)))
(setq tpx3 (+ (car a) (* th 28.0)))
(setq tpy (- (cadr a) ls))
)
(defun main_ ( / chk ss ar ans addsub buho sumc ssumc title
sum ssum arte sumte ssumte tp0 tp1 tp2 tp3 )
(graphscr)
(setq ar 0.0 a nil title “”
sum 0.0 sumc 1
ssum 0.0 ssumc 1
addsub “Add”)
(textpoint_)
(if (or (= nil hs) (>= 0 hs)) (setq hs 1))
(setq title (getstring 1 “nThe Title ?: “))
(initget (+ 1 2 3))
(setq hscale (getdist a
(strcat “nDrawing Scaling(DRAW=REAL)? <1=” (rtos hs 2 0) “>: 1=”)))
(if (= nil hscale) (setq hscale hs))
(setq hs hscale)
(command “text” a th “0” (strcat “Title : ” title))
(setq chk 1)
(while chk
(setq ss nil)
(setq ss (entsel (strcat
“nSelect object..[NO.” (rtos sumc) “] <” addsub “>: “)))
(if (= ss nil)
(progn
(initget “Add Sub Point eXit Next”)
(setq ans nil)
(setq ans (getkword
“nHur-area..(Add/Sub/textPoint/eXit/<Next>): “))
(cond
((= ans “Add”) (setq addsub “Add”)) ;cond=add
((= ans “Sub”) (setq addsub “Sub”)) ;cond=sub
((or (= ans “Next”) (= ans nil))
(progn
(setq addsub “Add”)
(setq tpy (- tpy ls))
(setq sum 0.0)
(setq sumc (1+ sumc))
(setq ar 0.0)
) ;end progn
) ;end cond=next
((= ans “Point”) (textpoint_))
((= ans “eXit”) (setq chk nil)) ;cond=exit
( T (setq addsub “Add”))
) ;end cond
) ;end then progn
(progn
(command “area” “e” ss)
(setq ar (* (getvar “area”) (* hscale hscale)))
(setq ar (/ (atoi (rtos (/ ar 10000) 2 0)) 100.0))
(if (= addsub “Add”)
(progn
(setq sum (+ sum ar))
(setq ssum (+ ssum ar))
(setq buho “+”)
) ;end then progn
(progn
(setq sum (- sum ar))
(setq ssum (- ssum ar))
(setq buho “-“)
) ;end else progn
) ;end if (addsub)
(setq arte (strcat buho (rtos ar 2 2)))
(setq sumte (rtos sum 2 2))
(setq ssumte (rtos ssum 2 2))
(setq tp0 (list tpx0 tpy))
(setq tp1 (list tpx1 tpy))
(setq tp2 (list tpx2 tpy))
(setq tp3 (list tpx3 tpy))
(command “text” “r” tp0 th “0” sumc)
(command “text” “r” tp1 th “0” arte)
(command “text” “r” tp2 th “0” sumte)
(command “text” “r” tp3 th “0” ssumte)
(setq tpy (- tpy ls))
(setq roopchk 0)
) ; end else progn
) ; end if
) ; end while
) ;
(main_)
)
(princ “nWelcom Hur-ARea ..”)
(princ “nType ‘HAR’ to start ..”)
공유