[기타] VBA에서 좌표값 대로 Insert 시키는 법 질문 드립니다.

[배관공사]

성심 성의껏 질문을 작성하여 주세요, 대충하시면 답변도 대충작성합니다.^^

① CAD 종류   : Auto cad

② VERSION   : 2013

③ 운영 체제    : Windows 7

④ 질문내용 및 스크린샷(이미지 및동영상)

 다들 수고가 많으십니다.

엑셀에서 캐드로 텍스트 입력시 좌표값을 설정하여 입력하고 싶습니다.

현재는 좌표를 캐드화면 상에서 직접 찍어 Prompt 되도록 되어 있습니다.

prompt1 = NL & "Insert point: "
stPnt = acadutil.GetPoint(, prompt1) <== prompt1을 좌표 값으로 입력되게 하려고 하는데 좌표값을 입력하면 글자들이 한곳으로만 모입니다.;; 이를 해결할 방법이 없을까요??

-------------------------------------------------------

 Dim textHgt As Double              'Declare text height variable
 Dim textStr As String              'Declare text string variable
 Dim textObj As Object              'Declare text object variable
 Dim lineObj As Object              'Declare line object variable
 Dim sset As Object
 
Dim stPnt, enPnt As Variant          'Define variables to receive return values
Dim prompt1, prompt2 As String       'Define variables for prompt strings

dimscale = acaddoc.GetVariable("DIMSCALE")  'dimscale값을 알아냄

If ds = True Then
    textHgt = th * dimscale                            'Set text height to 2.5
    rowh = rh * dimscale                             '줄높이
  Else
    textHgt = th
    rowh = rh
End If

Pi = Application.Pi()
bgaP = 0.5                              '수직line 과 글자의 간격
hgap = (rowh - textHgt) / 2                            '수평선과 글자의 간격

prompt1 = NL & "Insert point: "
stPnt = acadutil.GetPoint(, prompt1)  '시작점 입력

   Dim rngCells As Object              '엑셀오브젝트 정의
  Dim cell As Range
  Dim icount As Integer
 
  Set rngCells = Selection
  If Selection.Count = 1 Then
      MsgBox "2개 이상의 cell을 선택하셔야 합니다."
      Exit Sub
  End If
  ccount = Selection.Columns.Count  '열수
  rcount = Selection.Rows.Count     '줄수

  '각컬럼까지의 x거리
  Dim cwidth()                      '컬럼폭선언
  ReDim cwidth(ccount)              '컬럼폭 재정의 (컬럼수만큼)
  currentwidth = 0                  '현재 컬럼까지 폭
  For I = 1 To ccount               '컬럼수만큼 반복
    If rngCells.Columns.ColumnWidth = 0 Then      '숨겨진 column은 폭 없슴
        cwidth(I) = currentwidth + rngCells.Columns(I).ColumnWidth + bgaP * 2
      Else
        cwidth(I) = currentwidth + rngCells.Columns(I).ColumnWidth
    End If
    currentwidth = cwidth(I)
  Next I
 
  '각 줄까지의 y거리
  Dim rheight()                     'row 높이table 선언
  ReDim rheight(0 To rcount)        'row 높이 table 재선언(row 갯수만큼)
  currentheight = 0                 '현재 row까지의 총높이
  rheight(0) = 0                    '첫줄높이 초기화
 
  For I = 1 To rcount               '첫줄부터 끝줄까지
    rheight(I) = currentheight + rngCells.Rows(I).RowHeight / 13.5 * rowh
    currentheight = rheight(I)
    'MsgBox rheight(i)              '실험용 라인
  Next I
 
  'insPnt(2) = stPnt(2)                'Assign Z value to insertion point
 
  For j = 1 To ccount     '첫 줄 윗줄 그리기
    If rngCells(1, j).Borders(xlEdgeTop).LineStyle > 0 Then
        lPnt1(0) = stPnt(0) + cwidth(j - 1) * textHgt
        lPnt1(1) = stPnt(1)
        lPnt2(0) = stPnt(0) + cwidth(j) * textHgt
        lPnt2(1) = lPnt1(1)
        Set lineObj = moSpace.AddLine(lPnt1, lPnt2)
    End If
  Next j
 
 
  For I = 1 To rcount               '줄수만큼 반복
   
    '----- 각 줄의 첫수직선 그리기
    If rngCells(I, 1).Borders(xlEdgeLeft).LineStyle > 0 Then
        lPnt1(0) = stPnt(0)
        lPnt1(1) = stPnt(1) - rheight(I - 1)
        lPnt2(0) = lPnt1(0)
        'lPnt2(1) = stPnt(1) - i * rowh                 '고정행높이시
        lPnt2(1) = stPnt(1) - rheight(I)                '변동행높이시
        Set lineObj = moSpace.AddLine(lPnt1, lPnt2)
    End If
   
    For j = 1 To ccount             '열수만큼 반복
      If Selection.Columns(j).ColumnWidth <> 0 Then         '아래의 문장들은 숨기기가 안되있을때만 실행
       
      '----- 내용 쓰기
      If rngCells(I, j) = "" Then
          textStr = ""
        Else
          textfmt = rngCells(I, j).NumberFormatLocal
          If (IsNumeric(rngCells(I, j)) And textfmt <> "G/표준") Then
              If Mid(textfmt, Len(textfmt) - 1, 2) = "_ " Then textfmt = Mid(textfmt, 1, Len(textfmt) - 2)
              textStr = Application.Text(rngCells(I, j), textfmt)
            Else
              textStr = rngCells(I, j)
          End If
      End If                                                      'text format을 읽어 사용
     
      'insPnt(1) = stPnt(1) - i * rowh + hgap                   'text 삽입 y좌표(고정행높이)
      'insPnt(1) = stPnt(1) - rheight(i) / 13.5 * rowh + hgap    '변동행높이
     
     
     
      '정렬방법별로 text삽입
      'Select Case rngCells(i, j).HorizontalAlignment                    '정렬방법이
      '  Case xlCenter                                                   '가운데정렬인경우
      '    insPnt(0) = stPnt(0) + (cwidth(j) + cwidth(j - 1)) / 2 * textHgt
      '    Set textObj = moSpace.AddText(textStr, insPnt, textHgt)
      '    textObj.HorizontalAlignment = acHorizontalAlignmentCenter
      '    textObj.TextAlignmentPoint = insPnt
      '  Case xlRight                                                    '오른정렬인경우
      '    insPnt(0) = stPnt(0) + (cwidth(j) - bgaP) * textHgt
      '    Set textObj = moSpace.AddText(textStr, insPnt, textHgt)
      '    textObj.HorizontalAlignment = acHorizontalAlignmentRight
      '    textObj.TextAlignmentPoint = insPnt
      '  Case xlLeft                                                     '왼쪽정렬인경우
      '    insPnt(0) = stPnt(0) + (cwidth(j - 1) + bgaP) * textHgt
      '    Set textObj = moSpace.AddText(textStr, insPnt, textHgt)
      '  Case 1                                                          '표준인 경우
      '    If IsNumeric(rngCells(i, j)) Then                             '숫자인 경우
      '        insPnt(0) = stPnt(0) + (cwidth(j) - bgaP) * textHgt
      '        Set textObj = moSpace.AddText(textStr, insPnt, textHgt)
      '        If rngCells(i, j).Orientation = xlTickLabelOrientationUpward Then
      '            textObj.HorizontalAlignment = acHorizontalAlignmentLeft
      '            textObj.TextAlignmentPoint = insPnt
      '            textObj.Rotation = 0.5 * Application.Pi()
      '          Else
      '            textObj.HorizontalAlignment = acHorizontalAlignmentRight
      '            textObj.TextAlignmentPoint = insPnt
      '        End If
      '      Else                                                        '숫자가 아닌경우
      '        insPnt(0) = stPnt(0) + (cwidth(j - 1) + bgaP) * textHgt
      '        Set textObj = moSpace.AddText(textStr, insPnt, textHgt)
      '    End If
      '  End Select
      '
     
     
      '----- text x 삽입점 구하기
      Select Case rngCells(I, j).HorizontalAlignment
        Case xlCenter                                                   '가운데정렬인경우
          insPnt(0) = stPnt(0) + (cwidth(j) + cwidth(j - 1)) / 2 * textHgt
        Case xlRight                                                    '오른정렬인경우
          insPnt(0) = stPnt(0) + (cwidth(j) - bgaP) * textHgt
        Case xlLeft                                                     '왼쪽정렬인경우
          insPnt(0) = stPnt(0) + (cwidth(j - 1) + bgaP) * textHgt
        Case 1                                                          '표준인 경우
          If IsNumeric(rngCells(I, j)) Then                             '숫자인 경우
              insPnt(0) = stPnt(0) + (cwidth(j) - bgaP) * textHgt
            Else                                                        '숫자가 아닌경우
              insPnt(0) = stPnt(0) + (cwidth(j - 1) + bgaP) * textHgt
          End If
      End Select
     
      '----- text y삽입점 구하기
      Select Case rngCells(I, j).VerticalAlignment
        Case xlVAlignBottom                                             '아래정렬인 경우
          insPnt(1) = stPnt(1) - rheight(I) + hgap
        Case xlVAlignCenter                                             '가운데정렬인 경우
          insPnt(1) = stPnt(1) - (rheight(I - 1) + rheight(I)) / 2
        Case xlVAlignTop                                                '위정렬인 경우
          insPnt(1) = stPnt(1) - rheight(I - 1) - hgap
        Case 1                                                          '표준인 경우
          If IsNumeric(rngCells(I, j)) Then                             '숫자인 경우
              insPnt(1) = stPnt(1) - rheight(I - 1) - hgap
            Else                                                        '숫자가 아닌경우
              insPnt(1) = stPnt(1) - rheight(I) + hgap
          End If
      End Select
     
      Select Case rngCells(I, j).Orientation
        Case xlTickLabelOrientationUpward
          TextRotation = Pi / 2#
          Select Case rngCells(I, j).VerticalAlignment
            Case xlVAlignBottom
              HAlign = acHorizontalAlignmentLeft
            Case xlVAlignCenter
              HAlign = acHorizontalAlignmentCenter
            Case xlVAlignTop
              HAlign = acHorizontalAlignmentRight
            Case 1
              If IsNumeric(rngCells(I, j)) Then
                  HAlign = acHorizontalAlignmentRight
                Else
                  HAlign = acHorizontalAlignmentLeft
              End If
          End Select
          Select Case rngCells(I, j).HorizontalAlignment
            Case xlHAlignLeft
              VAlign = acVerticalAlignmentTop
            Case xlHAlignCenter
              VAlign = acVerticalAlignmentMiddle
            Case xlHAlignRight
              VAlign = acVerticalAlignmentBaseline
            Case 1
              If IsNumeric(rngCells(I, j)) Then
                  VAlign = acVerticalAlignmentBaseline
                Else
                  VAlign = acHorizontalAlignmentLeft
              End If
          End Select
        Case xlTickLabelOrientationHorizontal
          TextRotation = 0#
          Select Case rngCells(I, j).HorizontalAlignment
            Case xlHAlignLeft
              HAlign = acHorizontalAlignmentLeft
            Case xlHAlignRight
              HAlign = acHorizontalAlignmentRight
            Case xlHAlignCenter
              HAlign = acHorizontalAlignmentCenter
            Case 1
              If IsNumeric(rngCells(I, j)) Then
                  HAlign = acHorizontalAlignmentRight
                Else
                  HAlign = acHorizontalAlignmentLeft
              End If
          End Select
          Select Case rngCells(I, j).VerticalAlignment
            Case xlVAlignTop
              VAlign = acVerticalAlignmentTop
            Case xlVAlignCenter
              VAlign = acVerticalAlignmentMiddle
            Case xlVAlignBottom
              VAlign = acVerticalAlignmentBaseline
            Case 1
              If IsNumeric(rngCells(I, j)) Then
                Else
              End If
          End Select
      End Select

      Set textObj = moSpace.AddText(textStr, insPnt, textHgt)           'text삽입하기
      textObj.Rotation = TextRotation
      textObj.HorizontalAlignment = HAlign
      textObj.VerticalAlignment = VAlign
      textObj.TextAlignmentPoint = insPnt
     
      'insPnt(1) = stPnt(1) - rheight(i) / 13.5 * rowh + hgap    '변동행높이
     
     
     
      ', , xlVAlignDistributed, xlVAlignJustify, xlVAlignTop 등이 있습니다. 읽기/쓰기가 가능한 Long 형식입니다.
     
      '----- 수직선 그리기
      If rngCells(I, j).Borders(xlEdgeRight).LineStyle > 0 Then
        lPnt1(0) = stPnt(0) + cwidth(j) * textHgt
        'lPnt1(1) = stPnt(1) - (i - 1) * rowh
        lPnt1(1) = stPnt(1) - rheight(I - 1)
        lPnt2(0) = lPnt1(0)
        'lPnt2(1) = stPnt(1) - i * rowh                     '고정행높이 사용시
        lPnt2(1) = stPnt(1) - rheight(I)                    '변동행높이 사용시
        Set lineObj = moSpace.AddLine(lPnt1, lPnt2)
        If j < ccount Then lineObj.Color = acRed
      End If
      '----- 수평선 그리기
      If rngCells(I, j).Borders(xlEdgeBottom).LineStyle > 0 Then
        lPnt1(0) = stPnt(0) + cwidth(j - 1) * textHgt
        'lPnt1(1) = stPnt(1) - i * rowh                     'line의 y좌표(고정행높이)
        lPnt1(1) = stPnt(1) - rheight(I)                    '변화행높이
        lPnt2(0) = stPnt(0) + cwidth(j) * textHgt
        lPnt2(1) = lPnt1(1)
        Set lineObj = moSpace.AddLine(lPnt1, lPnt2)
        If I < rcount Then lineObj.Color = acRed
      End If
     
    End If
    Next j
  Next I
   
End Sub

--------------------------------------------------------------------------

⑤ 파일첨부 (LISP/DWG) - DWG 첨부시 보다 정확한 답변을 얻을수 있습니다.

※ 유의사항

 - ①말머리 : 말머리를 달아야 구분이 쉽겠죠^^(필수 선택)

 - ②Screenshot : 이해를 돕기위해 삽입요망.

 - ③파일 첨부 : 상위버전에서 테스트할 파일이 아니면 가급적 하위버전으로 저장후 첨부.

                          해당리습/해당파일(DWG) 도 같이 첨부하여 주세요.

 - ④제       목 : 질문 내용 반영(개략적인 내용),       예) 해치를 만들고 싶어요, pline을 연결할려면?

                     금지어(만들어주세요? 해주세요? 안되는데 이렇게 변경해주세요? 등등)

 - ⑤질문글 삭제금지 : 질문후 댓글이 달린글은 삭제금지.

    여러 리플러들이 소중한 시간을 내어서 고민한후 댓글을 작성한 이상 "강력조치" 토록 하겠음. 

※ 정답만이 댓글은 아닙니다. 그 답이 맞던 틀리던 그건 그 댓글로서 존중되어야 합니다.

    회원님들이 글을 읽었다는것과 댓글을 달았다는건 그만큼 관심을 가지고 있고 또 그 답을 해주기 위해

    검색도 해보고 도움말도 보고 고민도 하는 일련의 과정을 거치면서 나오기 때문이죠.

    이에 대한 고마움과 감사함을 모르는 테러행위(?)는 없었으면 합니다.

 

[가끔은]

위 적어주신 코드는 stPnt 란 변수에 캐드좌표(마우스로찍은)를 담는 역활밖에 없습니다
stPnt에 x,y,z 값이 들어갑니다

Prompt1은 캐드상 설명글일 뿐입니다

한곳으로 모이는 이유는 다른내용이 없어 도와드리기 어렵네요

[배관공사]

아; 제가 잘 몰라서요;; 이 부분만 고치면 된다고 생각했습니다.; 내용 수정하여 다시 올립니다.

[QNA~]

검색의 생활화..
InsertionPoint(0) = .Range("A" & i).Value
InsertionPoint(1) = .Range("B" & i).Value
InsertionPoint(2) = .Range("C" & i).Value

[아임피러]

가끔은 님 말씀처럼 소스코드를 보기 전에는 도와주기 힘들듯하네요 (올 뭔가 아는거 처럼.. 하지만 VBA 전혀 모른다는거~!!) 어차피 언어란게 도찐개찐이니
핵심 포인트 관련 소스와 엑셀 레인지 상태는 올려주셔야 정확한 답을 얻을수 있지 않을까요??

[가끔은]

위 코드 엑셀 VBA인가요? 캐드 VBA인가요?
둘다 있는것 같아 의야해서 질문드립니다..

일단 위 코드도 전체 코드는 아니군요..
부분부분만 있어서 이해하기 어렵습니다.

단순히 캐드에서 겹치는걸 해결하려면 삽입될때 for 같은 반복문 활용하시면 됩니다.

프로그램의 용도를 알고 어떤식으로 사용되는지 알아야 코드 수정이 가능할것 같습니다.
지금처럼 부분적인 코드만 봐선 모르겠네요~