자료실 Q&A
글 수 2,319
||||안녕하세요
캐드에서 point를 활용하여 점철근을 그린후 점철근의 좌표를 excel로 옮기고자 합니다.
그런데 생각만큼 잘 되지 않습니다.
ex)캐드에서 포인트 좌표를 선택하면 엑셀에서
x= 12.3 y=20.5
x=45.8 y=89.7
. .
. .
이런식으로 정리 되었으면 합니다.
제가 vbcad 참고하여 짠 것인데 보시고 해결 좀 해 주십시요.
Sub LWpolyline_좌표2()
'캐드의 활성화
AppActivate Application.Caption
'혹 선택 에러발생시 처리
On Error Resume Next
ThisDrawing.SelectionSets("TEMP").Delete
On Error GoTo 0
Dim a As Single
Dim i As Single
a = InputBox("단면의 철근개수를 입력하시요.")
'선택을 하기 위한 선언
Dim ssetObj As AcadSelectionSet
Set ssetObj = ThisDrawing.SelectionSets.Add("TEMP")
'캐드 화면에서 선택하라는 명령
ssetObj.SelectOnScreen
'여러개를 선택하였을때 한개씩 처리하는 부분
Dim X좌표 As Double
Dim Y좌표 As Double
Dim 좌표순서 As Boolean
Dim excel As Object
Dim excelsheet As Object
Set excel = GetObject(, "excel.application")
Set excelsheet = excel.ActiveWorkbook.Sheets("sheet1")
좌표순서 = True
For i = 1 To a
For Each 한개성분 In ssetObj
For Each 좌표 In 한개성분.Coordinates
If 좌표순서 Then '좌표순서=True 이면 X좌표, False이면 Y좌표임.
excelsheet.cells(i, 1) = 좌표
Else
excelsheet.cells(i, 2) = 좌표
'MsgBox X좌표 & " , " & Y좌표 'X,Y좌표값을 모두 알아낸 후 Msgbox로 보여줌
End If
좌표순서 = Not (좌표순서)
Next
Next 한개성분
Next i
'선택그룹을 삭제하지 않으면 두번째 실행시 에러표시 !주의!
ThisDrawing.SelectionSets("TEMP").Delete
End Sub
캐드에서 point를 활용하여 점철근을 그린후 점철근의 좌표를 excel로 옮기고자 합니다.
그런데 생각만큼 잘 되지 않습니다.
ex)캐드에서 포인트 좌표를 선택하면 엑셀에서
x= 12.3 y=20.5
x=45.8 y=89.7
. .
. .
이런식으로 정리 되었으면 합니다.
제가 vbcad 참고하여 짠 것인데 보시고 해결 좀 해 주십시요.
Sub LWpolyline_좌표2()
'캐드의 활성화
AppActivate Application.Caption
'혹 선택 에러발생시 처리
On Error Resume Next
ThisDrawing.SelectionSets("TEMP").Delete
On Error GoTo 0
Dim a As Single
Dim i As Single
a = InputBox("단면의 철근개수를 입력하시요.")
'선택을 하기 위한 선언
Dim ssetObj As AcadSelectionSet
Set ssetObj = ThisDrawing.SelectionSets.Add("TEMP")
'캐드 화면에서 선택하라는 명령
ssetObj.SelectOnScreen
'여러개를 선택하였을때 한개씩 처리하는 부분
Dim X좌표 As Double
Dim Y좌표 As Double
Dim 좌표순서 As Boolean
Dim excel As Object
Dim excelsheet As Object
Set excel = GetObject(, "excel.application")
Set excelsheet = excel.ActiveWorkbook.Sheets("sheet1")
좌표순서 = True
For i = 1 To a
For Each 한개성분 In ssetObj
For Each 좌표 In 한개성분.Coordinates
If 좌표순서 Then '좌표순서=True 이면 X좌표, False이면 Y좌표임.
excelsheet.cells(i, 1) = 좌표
Else
excelsheet.cells(i, 2) = 좌표
'MsgBox X좌표 & " , " & Y좌표 'X,Y좌표값을 모두 알아낸 후 Msgbox로 보여줌
End If
좌표순서 = Not (좌표순서)
Next
Next 한개성분
Next i
'선택그룹을 삭제하지 않으면 두번째 실행시 에러표시 !주의!
ThisDrawing.SelectionSets("TEMP").Delete
End Sub