다중면적을 구하려고 리습을 받았는데
면적 값만 나오고 PY평값은 안나오게 할수있을까요?
https://100cm24kg.tistory.com/105
여기서 다운받은 파일입니다

사진첨부가 잘못돼서 아래 첨부되었습니다.

 

(defun @ae()(c:ae))
(defun c:ae(/ dcl_id fn fname area ar1 ar2 ar3 ar4 ar5 ar6)

(defun *error* (msg)(princ “error: “)(princ msg)
(setvar “osmode” os)(setvar “orthomode” ot)
(redraw en1 4)
(princ))

(or c:md$ (setq c:md$ “ar1”))
(vl-load-com)
(create_dialog_area)
(setq dcl_id (load_dialog fname))

(setq area 0 ar1 “1” ar2 “0” ar3 “0” ar4 “0” ar5 “0” ar6 “0”)

(if (not ht0) (setq ht0 “1000”))
(setq ht1 ht0)
(if ht1 (setq ht0 ht1))

(if (not dot0) (setq dot0 “2”))
(setq dot1 dot0)
(if dot1 (setq dot0 dot1))

(if (not (new_dialog “area” dcl_id)) (exit) );if

(start_image “im”)
(end_image)

(set_tile “ht” ht0)
(set_tile “dot” dot0)

(set_tile c:md$ “1”)

(action_tile “ht” “(setq ht0 $value)”)
(action_tile “dot” “(setq dot0 $value)”)
(action_tile “ar1” “(setq c:md$ “ar1″)”)
(action_tile “ar2” “(setq c:md$ “ar2″)”)
(action_tile “ar3” “(setq c:md$ “ar3″)”)
(action_tile “ar4” “(setq c:md$ “ar4″)”)
(action_tile “ar5” “(setq c:md$ “ar5″)”)
(action_tile “ar6” “(setq c:md$ “ar6″)”)
(action_tile “accept” “(done_dialog)(setq userclick T)”)
(action_tile “cancel” “(done_dialog)(setq userclick nil)”)
(start_dialog)
(unload_dialog dcl_id)
(setq cmd c:md$)

(setq dt (atoi dot0))

(if userclick
(cond
((= cmd “ar1” ) (progn
(setq ent1 (entsel “nPline선택 or 내부점 선택 : “))
(if ent1
(progn
(setq en1 (car ent1)) (redraw en1 3)
(setq grpt (grread T))
(setq pt1 (cadr grpt))
(command “area” “e” ent1))
(progn
(prompt “nSelect internal point->”)
(command “boundary” pause “”)
(setq en1 (entlast))(redraw en1 3)
(command “area” “e” “l”)
(setq pt1 (getvar “lastpoint”)) )
)
(SETQ PP (GETPOINT “n Pick the Text point : “)
AREA (GETVAR “AREA”)
AA (/ AREA 1000000)
AREA1 (RTOS AA 2 dt)
)
(COMMAND “TEXT” PP ht0 “0” (strcat AREA1 ))
))

((= cmd “ar2” ) (progn
(setq ent1 (entsel “nPline선택 or 내부점 선택 : “))
(if ent1
(progn
(setq en1 (car ent1)) (redraw en1 3)
(setq grpt (grread T))
(setq pt1 (cadr grpt))
(command “area” “e” ent1))
(progn
(prompt “nSelect internal point->”)
(command “boundary” pause “”)
(setq en1 (entlast))(redraw en1 3)
(command “area” “e” “l”)
(setq pt1 (getvar “lastpoint”)) )
)
(SETQ PP (GETPOINT “n Pick the Text point : “)
AREA (GETVAR “AREA”)
AA (/ AREA 1000000)
AREA1 (RTOS AA 2 dt)
AREA2 (RTOS (* AA 0.3025) 2 dt)
)
(COMMAND “TEXT” PP ht0 “0” (strcat AREA1 “m² / ” AREA2 “py”))
))

((= cmd “ar3” ) (progn
(setq ent1 (entsel “nPline선택 or 내부점 선택 : “))
(if ent1
(progn
(setq en1 (car ent1)) (redraw en1 3)
(setq grpt (grread T))
(setq pt1 (cadr grpt))
(command “area” “e” ent1))
(progn
(prompt “nSelect internal point->”)
(command “boundary” pause “”)
(setq en1 (entlast))(redraw en1 3)
(command “area” “e” “l”)
(setq pt1 (getvar “lastpoint”)) )
)
(SETQ PP (GETPOINT “n Pick the Text point : “)
AREA (GETVAR “AREA”)
AA (/ AREA 1000000)
AREA1 (RTOS AA 2 dt)
AREA2 (RTOS (* AA 0.3025) 2 dt)
)
(COMMAND “TEXT” “j” “m” PP ht0 “0” (strcat AREA1 “m²”))
(COMMAND “TEXT” “” (strcat “(” AREA2 “py)”))
))

((= cmd “ar4” ) (@aq))
((= cmd “ar5” ) (@arr))
((= cmd “ar6” ) (@autoarea))
)
)

(redraw en1 4)
(vl-file-delete fname)

(princ)
)

(defun create_dialog_area()
(setq fname (vl-filename-mktemp “area.dcl”))
(setq fn (open fname “w”))
(write-line “area : dialog
{label = “AREA CALCULATION”;
initial_focus = “area”;

: boxed_column {
label = “◁ Setting ▷”;
: edit_box {
label = “텍스트사이즈 :”;
key = “ht”;
allow_accept = true;
edit_width = 20;
fixed_width = true;
}

: edit_box {
label = “소수점자리수 :”;
key = “dot”;
allow_accept = true;
edit_width = 20;
fixed_width = true;
}
}
spacer_1;
: boxed_column {
label = “◁ Choose Reprentation ▷”;
: radio_button { key = “ar1”;
label = “▒ (&1) [oo]㎡ 면적 숫자만 표시 “; }
: radio_button { key = “ar2”;
label = “▒ (&2) [oo]㎡ / [oo]평 일렬로 표시 “; }
: radio_button { key = “ar3”;
label = “▒ (&3) [oo]㎡ / [oo]평 칸 나눠서 표시 “; }
: radio_button { key = “ar4”;
label = “▒ (&4) 다중면적 자동 표기 (㎡ / 평) “; }
: radio_button { key = “ar5”;
label = “▒ (&5) 다중면적 자동 표기 / 테이블 생성 “; }
: radio_button { key = “ar6”;
label = “▒ (&6) Pline 변경시 면적 자동 변경 “; }

}

spacer_1;
: row {
: button {
label = “&OK”;
key = “accept”;
width = 20;
fixed_width = true;
is_default = true;
}
: button {
label = “&Cancel”;
key = “cancel”;
width = 20;
fixed_width = true;
is_cancel = true;
}}

: row {
: image { key = “im” ;
color = 5 ;
width = 1.5;
fixed_width = true;}
: paragraph {
: text_part { label = “Designed and Created “;}
: text_part { label = “By 100cm24kg.tistory.com”;}
}}

}
” fn)
(close fn)
);
(princ)

(defun @arr()(c:arr))
(defun c:arr ( / doc space ss n sum obj sp ep cplst area sum cdn mp v sa xp yp pt
chlst txtobj objname table arlst cnt enlst ptlst olden newen xlst sum)
(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 . “line,lwpolyline,circle,ellipse,region”))))) (exit))
(setq $sn (memory “소수자리 입력” 2 $sn)) ;소수자리 기본값 변경시 2를 변경
(setq $tsz (memory “문자크기 입력” 100 $tsz)) ;문자크기 기본값 변경시 10을 변경
(setq n 0)
(repeat (sslength ss)
(setq obj (vlax-ename->vla-object (setq en (ssname ss n))))
(setq objname (vla-get-objectname obj))
(if (equal objname “AcDbLine”)
(progn
(setq pt (list (vlax-get obj ‘startpoint) (vlax-get obj ‘endpoint)))
(setq ptlst (append ptlst (list pt)))
(setq enlst (cons en enlst))
)
)
(setq n (1+ n))
)
(if enlst
(progn
(foreach x enlst (setq ss (ssdel x ss)))
(setq olden (getenlst nil))
(foreach x (connectlst ptlst)
(if (equal (distance (car x) (last x)) 0 0.1)
(progn
(setq lst (apply ‘append (mapcar ‘(lambda (z) (list (car z) (cadr z))) x)))
(vla-addlightweightpolyline space (vlax-make-variant (vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble (cons 0 (- (length lst) 1))) lst)))
)
)
)
(setq newen (getenlst nil))
(setq chlst (makelst olden newen))
(foreach x chlst (setq ss (ssadd x ss)))
)
)
(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 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 (list xp yp))
(setq arlst (append arlst (list (list pt area))))
)
)
)
(progn
(setq area (rtos (* (vla-get-area obj) 0.000001) 2 $sn))
(if (equal objname “AcDbRegion”)
(setq pt (append (vlax-get obj ‘centroid) (list 0.0)))
(setq pt (vlax-get obj ‘center))
)
(setq arlst (append arlst (list (list pt area))))
)
)
(setq n (1+ n))
)
(if chlst (foreach x chlst (vla-delete (vlax-ename->vla-object x))))
(setq arlst (vl-sort (vl-sort arlst ‘(lambda (a b) ( (cadr (car a)) (cadr (car b))))))
(setq n 1)
(foreach x arlst
(setq pt (vlax-3d-point (car x)))
(setq txtobj (vla-addtext space (cadr x) pt $tsz)) ;no number (strcat (rtos n) ” : ” (cadr x)) ⇒ (cadr x)
(vla-put-alignment txtobj 4)
(vla-put-textalignmentpoint txtobj pt)
(vla-update txtobj)
(setq n (1+ n))
)
(if (not (equal (setq sum (rtos (apply ‘+ (mapcar ‘(lambda (x) (atof (cadr x))) arlst)) 2 $sn)) “0”))
(progn
(setq cnt (length arlst) n 2)
(if (setq pt (getpoint “n>> 테이블 작성 포인트 지정:”))
(progn
(setq table (vla-addtable space (vlax-3d-point pt) (+ cnt 3) 2 (* $tsz 2) (* $tsz 10)))
(vla-settext table 0 0 “Area Table”)
(vla-settext table 1 0 “No.”)
(vla-settext table 1 1 “Area”)
(vla-settext table (+ cnt 2) 0 “Total”)
(vla-settext table (+ cnt 2) 1 sum)
(foreach x arlst
(vla-settext table n 0 (itoa (- n 1)))
(vla-settext table n 1 (cadr x))
(setq n (1+ n))
)
(setq n 0)
(repeat (+ cnt 3)
(vla-setcelltextheight table n 0 $tsz)
(vla-setcellalignment table n 0 5)
(vla-setcelltextheight table n 1 $tsz)
(vla-setcellalignment table n 1 5)
(setq n (1+ n))
)
(vla-setcolumnwidth table 0 (* $tsz 6))
)
)
)
)
(princ)
)

(defun memory (msg bval mval / sval)
(if (equal mval nil) (setq mval bval))
(initget 4)
(setq sval (getint (strcat “n>> ” msg ” :”)))
(if sval (setq mval sval) mval)
)

(defun makelst (old new / )
(foreach x old
(if (member x new) (setq new (vl-remove x new)))
)
new
)

(defun getenlst (sets / enlst i)
(if (not sets) (setq sets (ssget “x”)))
(setq i 0)
(repeat (sslength sets)
(setq enlst (cons (ssname sets i) enlst))
(setq i (1+ i))
)
enlst
)

(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 connectlst (lst / n re en tn)
(setq n 0)
(while (> (length lst) n)
(setq en (nth n lst) tn nil)
(foreach x (cdr lst)
(if (and (equal (distance (last en) (car x)) 0 0.1) (not (equal en x)))
(progn
(setq lst (subst (append en (cdr x)) en lst))
(setq lst (vl-remove x lst) tn t)
)
)
(if (and (equal (distance (last en) (last x)) 0 0.1) (not (equal en x)))
(progn
(setq lst (subst (append en (cdr (reverse x))) en lst))
(setq lst (vl-remove x lst) tn t)
)
)
)
(if tn (setq n 0) (setq n (1+ n)))
)
lst
)

(defun *error* (msg)
(if (/= msg “function cancelled”)
(if (= msg “quit / exit abort”)
(princ)
(princ (strcat “nerror: ” msg))
)
(princ)
)
(princ)
)

; AUTO AREA ————————————————————————————————————————————

(defun @autoarea()(c:autoarea))
(defun c:autoarea (/ Sel EntData PolyObj TextObj ReactList Pos)

(vl-load-com)
(if
(and
(setq Sel (entsel “n Select polyline to get area of: “))
(setq EntData (entget (car Sel)))
(= (cdr (assoc 0 EntData)) “LWPOLYLINE”)
(setq PolyObj (vlax-ename->vla-object (car Sel)))
(setq Sel (entsel “n Select text of hold area value: “))
(setq EntData (entget (car Sel)))
(vl-position (cdr (assoc 0 EntData)) ‘(“TEXT” “MTEXT”))
(setq TextObj (vlax-ename->vla-object (car Sel)))
)
(progn
(PutArea PolyObj TextObj)
(if
(and
(setq ReactList (AssociatedReactors PolyObj))
(setq Pos (vl-position “MyAreaReactorModified” (mapcar ‘vlr-data ReactList)))
)
(vlr-remove (nth Pos ReactList))
)
(vlr-pers
(vlr-object-reactor
(list PolyObj)
“MyAreaReactorModified”
‘(
(:vlr-modified . MakeCmdEndReactor)
(:vlr-erased . ObjectEraseReactor)
; (:vlr-unerased . ObjectUnErasedReactor)
)
)
)
)
)
(princ)
)

;—————————————————————————————————————
(defun PutArea (PolyObj TextObj / Dict xRec SqFt)

(setq Dict (vla-GetExtensionDictionary PolyObj))
(if (vl-catch-all-error-p (setq xRec (vl-catch-all-apply ‘vla-Item (list Dict “MyAreaReactor”))))
(setq xRec (vla-AddXRecord Dict “MyAreaReactor”))
)
(MySetXrec xRec ‘(40 1) (list (vlax-get PolyObj ‘Area) (vlax-get TextObj ‘Handle)))
(setq SqFt (/ (vla-get-Area PolyObj) 1000000))
(vla-put-TextString TextObj (rtos SqFt 2 4))
;;(setq SqFt (/ (vla-get-Area PolyObj) 144.0))
;;(vla-put-TextString TextObj (strcat (rtos SqFt 2 4) ” SQ.FT.”))
xRec
)
;—————————————————————————————————————-
(defun MakeCmdEndReactor (Obj React NotSure)

(if (not (wcmatch (getvar “cmdnames”) “U,UNDO,REDO,OOPS”))
(progn
(if GlbVarAreaObject
(setq GlbVarAreaObject (append GlbVarAreaObject (list Obj)))
(setq GlbVarAreaObject (list Obj))
)
(if (not GlbReactorCommandEnd)
(setq GlbReactorCommandEnd (vlr-command-reactor “tempAreaCommandReactor” ‘((:vlr-commandEnded . AdjustTextObj))))
)
)
)
(princ)
)
;——————————————————————————————————————
(defun ObjectEraseReactor (Obj React NotSure)

(vlr-pers-release React)
(vlr-remove React)
)
;—————————————————————————————————————–
(defun ObjectUnErasedReactor (Obj React NotSure)

(vlr-pers
(vlr-object-reactor
(list Obj)
“MyAreaReactorModified”
‘(
(:vlr-modified . MakeCmdEndReactor)
(:vlr-erased . ObjectEraseReactor)
(:vlr-unerased . ObjectUnErasedReactor)
)
)
)
)
;—————————————————————————————————————–
(defun AdjustTextObj (React CommandList / Dict xRec xRecList TextObj)

(foreach Obj GlbVarAreaObject
(if (not (vlax-erased-p Obj))
(progn
(setq Dict (vla-GetExtensionDictionary Obj))
(if (not (vl-catch-all-error-p (setq xRec (vl-catch-all-apply ‘vla-Item (list Dict “MyAreaReactor”)))))
(progn
(setq xRecList (MyGetXRec xRec))
(if
(and
(setq TextObj (vlax-ename->vla-object (setq tmpEnt (handent (cdr (assoc 1 xRecList))))))
(not (vlax-erased-p TextObj))
)
(PutArea Obj TextObj)
(progn
(foreach i (AssociatedReactors Obj)
(if (= (vlr-data i) “MyAreaReactorModified”)
(progn
(vlr-pers-release i)
(vlr-remove i)
)
)
)
(prompt “n Reactor has be removed because the text object has been erased.”)
)
)
)
)
)
)
)
(setq GlbVarAreaObject nil)
(vlr-remove GlbReactorCommandEnd)
(setq GlbReactorCommandEnd nil)
)
;—————————————————————————
(defun MySetXRec (Obj CodeList DataList / )
; Sets XRecordData. Dxf numbers between 1-369, except 5, 100, 105.
; See help for types and numbers to use.

(vla-SetXRecordData Obj
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbInteger
(cons 0 (1- (length CodeList)))
)
CodeList
)
)
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbVariant
(cons 0 (1- (length Datalist)))
)
DataList
)
)
)
)
;—————————————————————————–
(defun MyGetXRec (Obj / CodeType DataType)
; Retrive XRecordData for an object

(vla-GetXRecordData
Obj
‘CodeType
‘DataType
)
(if (and CodeType DataType)
(mapcar
‘(lambda (a b)
(cons a (variant-value b))
)
(safearray-value CodeType)
(safearray-value DataType)
)
)
)
;————————————————————————————-
(defun AssociatedReactors (Obj / ReactList)
; Return a list of reactors (object type) associated with an object.
; Use like (AssociatedReactors (vlax-ename->vla-object (car (entsel))))

(foreach i (cdar (vlr-reactors :vlr-object-reactor))
(if (vl-position Obj (vlr-owners i))
(setq ReactList (cons i ReactList))
)
)
ReactList
)
;—————————————————————————
(defun RemovePersReact ()
; Remove persistant reactors that don’t have an owner.

(foreach i (vlr-pers-list)
(if (not (vlr-owners i))
(progn
(vlr-pers-release i)
(vlr-remove i)
)
)
)
)

다중면적 ————————————————————————————————————————

(defun @aq ()(c:aq))
(defun c:aq( / 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텍스트 높이 입력 :”))) (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)))
(setq AA (/ AREA 1000000)
AREA1 (RTOS AA 2 2)
AREA2 (RTOS (* AA 0.3025) 2 2))
(setq p1 (polar inspt 1.5708 (* ts 0.25)) p2 (polar inspt 4.71239 (* ts 0.25)))
(setq txtobj (vla-addtext space (strcat area1 “㎡”) (vlax-3d-point p1) ts))
(vla-put-alignment txtobj acAlignmentBottomLeft )
(vla-put-textalignmentpoint txtobj (vlax-3d-point p1))
(setq txtobj (vla-addtext space (strcat “(“area2″py)”) (vlax-3d-point p2) ts))
(vla-put-alignment txtobj acAlignmentTopLeft)
(vla-put-textalignmentpoint txtobj (vlax-3d-point p2))
(setq inspt (polar inspt (/ (* 270 pi) 180) (* ts 2)))

(setq index (1+ index))
)
)
)
)
(princ)
)
(vl-load-com)
(princ)

(defun c:aq( / 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텍스트 높이 입력 :”))) (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)))
(setq AA (/ AREA 1000000)
AREA1 (RTOS AA 2 dt)
AREA2 (RTOS (* AA 0.3025) 2 dt) )
(setq p1 (polar inspt 1.5708 (* ts 0.25)) p2 (polar inspt 4.71239 (* ts 0.25)))
(setq txtobj (vla-addtext space (strcat area1 “㎡”) (vlax-3d-point p1) ts))
(vla-put-alignment txtobj acAlignmentBottomLeft )
(vla-put-textalignmentpoint txtobj (vlax-3d-point p1))
(setq txtobj (vla-addtext space (strcat “(“area2″py)”) (vlax-3d-point p2) ts))
(vla-put-alignment txtobj acAlignmentTopLeft)
(vla-put-textalignmentpoint txtobj (vlax-3d-point p2))
(setq inspt (polar inspt (/ (* 270 pi) 180) (* ts 2)))

(setq index (1+ index))
)
)
)
)
(princ)
)
(vl-load-com)
(princ)