캐드 분류
해치테이블 리습입니다. 면적단위수정 (㎡) 부탁드립니다.
컨텐츠 정보
- 212 조회
- 2 댓글
- 0 추천
- 0 비추천
- 목록
본문
레이로 구별된 해치를 선택하면 해치 면적을 표로 만들어주는
리습입니다. 표로 정리된는데 단위가 ㎡가 아닙니다. 면적 단위 변경 요청드립니다.
(Defun c:HatchTAble ( / AllData ss e edata Area_table crow bn area_ ssNH)
(vl-load-com)
;;; pBe 23Apr2013 ;;;
;;; Mod for FSJ_Mo : Layer instead of Block swatches ;;;
;; pBe 18Jul2013 ;;;
(if
(setq AllData nil ssNH (ssadd)
ss (ssget '((0 . "Hatch")))
)
(progn
(repeat (setq i (sslength ss))
(setq e (vlax-ename->vla-object (ssname ss (Setq i (1- i)))))
(setq edata
(list
(vlax-get e 'Layer)
(IF
(not
(vl-catch-all-error-p
(setq area_ (vl-catch-all-apply 'vla-get-area (list E)))
)
)
area_
(progn (ssadd (ssname ss i) ssNH) 0.0)
)
)
)
(setq AllData
(if (setq f (assoc (car edata) AllData))
(subst (list (car f) (+ (cadr f) (cadr edata))) f Alldata)
(cons edata AllData)
)
)
)
(setq AllData (vl-sort AllData '(lambda (m n) (> (Cadr m) (cadr n)))))
(setq Area_table
(vlax-invoke
(vlax-get (vla-get-ActiveLayout
(vla-get-activedocument (vlax-get-acad-object))
)
'Block
)
'Addtable
(getpoint "nPick point for Table:")
2 2 50 275
)
)
(vla-settext Area_table 0 0 "Area Tabulation")
(vla-setcelltextheight Area_table 0 0 20.0)
(mapcar '(lambda (y)
(vla-settext Area_table 1 (car y) (cadr y))
(vla-setcelltextheight Area_table 1 (car y) 20.0)
)
(list '(0 "Area") '(1 "Layer"))
)
(foreach d AllData
(vla-insertrows
Area_table
(1+ (setq crow (vla-get-rows Area_table)))
50
1
)
(vla-setCellValue Area_table crow 0 (cadr d))
(vla-setcelltextheight Area_table crow 0 20.0)
(vla-setCellAlignment Area_table crow 0 5)
(vla-setcellformat Area_table crow 0 "%lu2%pr2%th44″)
(vla-setcelltextheight Area_table crow 1 20.0)
(vla-setCellAlignment Area_table crow 1 5)
(vla-setCellValue Area_table crow 1 (car d))
)
)
)
(princ)
)
관련자료
댓글 2
/ 1 페이지
