캐드 분류
캐드에서 범위안에 모든 테이블 엑셀로 추출하는법?
컨텐츠 정보
- 122 조회
- 6 댓글
- 0 추천
- 0 비추천
- 목록
본문
AppActivate Application.Caption
Dim sset As AcadSelectionSet
Dim mode As Integer
Dim corner1 As Variant
Dim corner2 As Variant
Dim pnt1 As Variant
Dim pnt2 As Variant
Dim tc As Integer
On Error Resume Next
ThisDrawing.SelectionSets("SSET").Delete
On Error GoTo 0
Set sset = ThisDrawing.SelectionSets.Add("SSET")
pnt1 = ThisDrawing.Utility.GetPoint(, "1st Point")
pnt2 = ThisDrawing.Utility.GetPoint(, "2nd Point")
corner1 = pnt1
corner2 = pnt2
Dim gpCode(0) As Integer
Dim dataValue(0) As Variant
gpCode(0) = 0
dataValue(0) = AcadTable
Dim groupCode As Variant, dataCode As Variant
groupCode = gpCode
dataCode = dataValue
mode = acSelectionSetCrossing
sset.Select mode, corner1, corner2, groupCode, dataCode
tc = sset.Count
Dim i As Integer
Dim lr As Integer
Dim sheet As Object
Dim Worksheets As Object
Dim Workbooks As Object
Dim excelSheet As Object
On Error Resume Next
Dim EXcelapp As Object
Set EXcelapp = GetObject(, "excel.application")
On Error GoTo 0
If Err Then
MsgBox ("엑셀 실행감지 에러")
Err.Clear
Set EXcelapp = CreateObject("excel.application")
If Err Then
MsgBox Err.Description
Exit Sub
End If
End If
EXcelapp.Visible = True
Dim ACtiveworkbook As Object
Set ACtiveworkbook = EXcelapp.ACtiveworkbook
AppActivate EXcelapp.Caption
For i = 1 To tc
lr = Worksheets("Sheet1″).Cells(Rows.Count, 2).End(3)(2).row
DateValue(i).Copy
Worksheets("Sheet1″).Cells(LastRow, 2).Offset(1, 0).PasteSpecial xlPasteAll
Next i
대강 짜집기하면서 진행했는데 범위는 선택하는데 범위 안에 있는 모든 테이블 선택하는 방법이 멀까요?
그 테이블의 수 만큼 반복해서 엑셀로 옴기려고하는데 조언이나 좋은 구문있으면 알려주세요
그리고 리습으로하는게 나을지 vba로 하는게 나을지 리습은 맨땅에 해딩이라
(defun c:expc ()
(setq p1 (getpoint "첫번째 점을 찍으세요"))
(setq p2 (getpoint "두번째 점을 찍으세요"))
(princ))
(setq tt (ssget "cp" "p1″ "p2″))
);defun end
이 이후에 테이블 조건을 못넣고있습니다. 도와주십쇼
관련자료
댓글 6
