반응형

Mohr's circle VBA code by ChatGPT

 

Sub CreateMohrsCircle()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Replace "Sheet1" with your worksheet name
    
    ' Input variables
    Dim sigma_x As Double
    Dim sigma_y As Double
    Dim tau_xy As Double
    
    ' Prompt the user to enter the values
    sigma_x = InputBox("Enter sigma_x:")
    sigma_y = InputBox("Enter sigma_y:")
    tau_xy = InputBox("Enter tau_xy:")
    
    ' Calculate the center and radius of the circle
    Dim sigma_avg As Double
    sigma_avg = (sigma_x + sigma_y) / 2
    
    Dim R As Double
    R = ((sigma_x - sigma_y) ^ 2 + (2 * tau_xy) ^ 2) ^ 0.5 / 2
    
    ' Calculate the angle of rotation
    Dim theta As Double
    theta = 0.5 * WorksheetFunction.Atan(2 * tau_xy / (sigma_x - sigma_y))
    
    ' Clear previous data and labels
    ws.Range("A1:F20").ClearContents
    
    ' Draw the circle
    Dim angle As Double
    Dim point_x As Double
    Dim point_y As Double
    
    For angle = 0 To 2 * WorksheetFunction.Pi Step 0.01
        point_x = sigma_avg + R * Cos(angle - theta)
        point_y = R * Sin(angle - theta)
        
        ws.Cells(Round(point_y) + 11, Round(point_x) + 11).Value = "•"
    Next angle
    
    ' Draw axes and labels
    ws.Range("E11:F11").Value = Array("σ", "τ")
    ws.Range("J11:K11").Value = Array("σ", "-τ")
    ws.Range("G6:H6").Value = Array("σ_x", "τ_xy")
    ws.Range("I6").Value = sigma_x
    ws.Range("J7").Value = -tau_xy
    
    ' Draw the center and radius
    ws.Cells(11, sigma_avg + 11).Value = "•"
    ws.Range("J12:K12").Value = Array("Center:", "Radius:")
    ws.Range("J13").Value = sigma_avg
    ws.Range("K13").Value = R
    
    ' Format the circle and labels
    With ws.Range("A1:F20")
        .HorizontalAlignment = xlCenter
        .Font.Name = "Arial"
        .Font.Size = 8
    End With
    
    With ws.Range("E11:F11", "J13:K13")
        .Font.Bold = True
    End With
    
    ' Adjust column widths and row heights
    ws.Columns("A:F").ColumnWidth = 2
    ws.Columns("G:K").ColumnWidth = 8
    ws.Rows("1:10").RowHeight = 12
End Sub

To use this code, follow these steps:

  1. Open your Excel workbook and press Alt+F11 to open the VBA Editor.
  2. Insert a new module by clicking on "Insert" > "Module."
  3. Copy and paste the code into the new module.
  4. Modify the worksheet name in the line Set ws = ThisWorkbook.Sheets("Sheet1") to match your desired worksheet name.
  5. Save the workbook and close the VBA Editor.
  6. Press Alt+F8 to open the "Macro" dialog box.
  7. Select the "CreateMohrsCircle" macro and click "Run."
  8. The macro will prompt you to enter the values of sigma_x, sigma_y, and tau_xy in separate input boxes.
  9. Enter the values and click "OK."
  10. The Mohr's circle will be created on the specified worksheet with the entered values.

Please note that this code assumes you have a worksheet named "Sheet1" where the Mohr's circle will be created. Modify the code accordingly if you want to use a different worksheet name or if you want to adjust the layout or formatting of the circle.

Additionally, the code currently draws the Mohr's circle using text-based symbols ('•') in the worksheet. If you prefer a graphical representation, you can use VBA to create a scatter plot or utilize Excel's built-in charting features to display the circle. Let me know if you would like assistance with that aspect as well.

 

 

 

Sub CreateMohrsCircle()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Replace "Sheet1" with your worksheet name
    
    ' Input variables
    Dim sigma_x As Double
    Dim sigma_y As Double
    Dim tau_xy As Double
    
    ' Prompt the user to enter the values
    sigma_x = InputBox("Enter sigma_x:")
    sigma_y = InputBox("Enter sigma_y:")
    tau_xy = InputBox("Enter tau_xy:")
    
    ' Calculate the center and radius of the circle
    Dim sigma_avg As Double
    sigma_avg = (sigma_x + sigma_y) / 2
    
    Dim R As Double
    R = ((sigma_x - sigma_y) ^ 2 + (2 * tau_xy) ^ 2) ^ 0.5 / 2
    
    ' Calculate the angle of rotation
    Dim theta As Double
    theta = 0.5 * WorksheetFunction.Atan(2 * tau_xy / (sigma_x - sigma_y))
    
    ' Clear previous data and labels
    ws.Range("A1:F20").ClearContents
    
    ' Draw the circle
    Dim angle As Double
    Dim point_x As Double
    Dim point_y As Double
    
    For angle = 0 To 2 * WorksheetFunction.Pi Step 0.01
        point_x = sigma_avg + R * Cos(angle - theta)
        point_y = R * Sin(angle - theta)
        
        ws.Cells(Round(point_y) + 11, Round(point_x) + 11).Value = "•"
    Next angle
    
    ' Draw axes and labels
    ws.Range("E11:F11").Value = Array("σ", "τ")
    ws.Range("J11:K11").Value = Array("σ", "-τ")
    ws.Range("G6:H6").Value = Array("σ_x", "τ_xy")
    ws.Range("I6").Value = sigma_x
    ws.Range("J7").Value = -tau_xy
    
    ' Draw the center and radius
    ws.Cells(11, sigma_avg + 11).Value = "•"
    ws.Range("J12:K12").Value = Array("Center:", "Radius:")
    ws.Range("J13").Value = sigma_avg
    ws.Range("K13").Value = R
    
    ' Format the circle and labels
    With ws.Range("A1:F20")
        .HorizontalAlignment = xlCenter
        .Font.Name = "Arial"
        .Font.Size = 8
    End With
    
    With ws.Range("E11:F11", "J13:K13")
        .Font.Bold = True
    End With
    
    ' Adjust column widths and row heights
    ws.Columns("A:F").ColumnWidth = 2
    ws.Columns("G:K").ColumnWidth = 8
    ws.Rows("1:10").RowHeight = 12
    
    ' Create a scatter plot chart
    Dim cht As ChartObject
    Set cht = ws.ChartObjects.Add(Left:=ws.Cells(1, 8).Left, Top:=ws.Cells(1, 8).Top, Width:=400, Height:=300)
    
    With cht.Chart
        ' Add a scatter plot series
        .SeriesCollection.NewSeries
        .SeriesCollection(1).Name = "Mohr's Circle"
        .SeriesCollection(1).XValues = ws.Range("A11:A31")
        .SeriesCollection(1).Values
        .SeriesCollection(1).Values = ws.Range("B11:B31")
        
        ' Set chart type and style
        .ChartType = xlXYScatter
        .ChartStyle = 8 ' Adjust the chart style as desired
        
        ' Set axis labels
        .Axes(xlCategory).HasTitle = True
        .Axes(xlCategory).AxisTitle.Text = "σ"
        .Axes(xlValue).HasTitle = True
        .Axes(xlValue).AxisTitle.Text = "τ"
        
        ' Set axis scales
        .Axes(xlCategory).MinimumScale = sigma_avg - R
        .Axes(xlCategory).MaximumScale = sigma_avg + R
        .Axes(xlValue).MinimumScale = -R
        .Axes(xlValue).MaximumScale = R
        
        ' Set chart title
        .HasTitle = True
        .ChartTitle.Text = "Mohr's Circle"
    End With
End Sub

After running the modified code, a scatter plot chart representing the Mohr's circle will be created in the specified worksheet. The chart will display the σ values on the x-axis and the τ values on the y-axis. The axis scales and titles will be set accordingly. You can adjust the chart style, axis labels, or other formatting options as desired.

Remember to modify the worksheet name in the line Set ws = ThisWorkbook.Sheets("Sheet1") to match your desired worksheet name.

Let me know if you need further assistance!

반응형

'VBA' 카테고리의 다른 글

VBA를 사용하여 X 축과 Y 축의 범위 값을 가져오기  (0) 2023.06.14
엑셀 차트크기 조절 VBA  (0) 2023.04.04
셀 값이 0인 경우 해당 셀 값 삭제  (0) 2023.02.21
열너비 바꾸는 VBA  (0) 2023.02.20
데이터 정렬하기  (0) 2023.02.17
반응형

VBA를 사용하여 X 축과 Y 축의 범위 값을 가져오기

 

 

ChatGPT의 답변은 다음과 같다.

 

Sub GetAxisRanges()
    Dim myChart As ChartObject
    Dim xAxis As Axis, yAxis As Axis
    Dim xAxisMin As Variant, xAxisMax As Variant
    Dim yAxisMin As Variant, yAxisMax As Variant
    
    ' 차트 개체 가져오기
    Set myChart = ActiveSheet.ChartObjects("Chart 1")
    
    ' X 축과 Y 축 가져오기
    Set xAxis = myChart.Chart.Axes(xlCategory)
    Set yAxis = myChart.Chart.Axes(xlValue)
    
    ' X 축 범위 가져오기
    xAxisMin = xAxis.MinimumScale
    xAxisMax = xAxis.MaximumScale
    
    ' Y 축 범위 가져오기
    yAxisMin = yAxis.MinimumScale
    yAxisMax = yAxis.MaximumScale
    
    ' 결과 출력
    MsgBox "X 축 범위: " & xAxisMin & " ~ " & xAxisMax & vbNewLine & _
           "Y 축 범위: " & yAxisMin & " ~ " & yAxisMax
End Sub
반응형

'VBA' 카테고리의 다른 글

Mohr's circle VBA code  (0) 2023.06.16
엑셀 차트크기 조절 VBA  (0) 2023.04.04
셀 값이 0인 경우 해당 셀 값 삭제  (0) 2023.02.21
열너비 바꾸는 VBA  (0) 2023.02.20
데이터 정렬하기  (0) 2023.02.17
반응형

엑셀 차트크기 조절 VBA

 

Sub ResizeChart()
    With ActiveSheet.ChartObjects("Chart 1")
        .Width = 500 '크기 설정
        .Height = 300 '크기 설정
    End With
End Sub

 

A1셀에 width값, A2셀에 heigth값을 이용하여 차트의 크기 수정

Sub ResizeChart()
    With ActiveSheet.ChartObjects(1)
        .Width = Range("A1").Value
        .Height = Range("A2").Value
    End With
End Sub

 

위치와 크기를 설정

Sub ResizePlotArea()
    With ActiveSheet.ChartObjects("Chart 1").Chart.PlotArea
        .Left = 50 '위치 설정
        .Top = 50 '위치 설정
        .Width = 400 '크기 설정
        .Height = 200 '크기 설정
    End With
End Sub
반응형

'VBA' 카테고리의 다른 글

Mohr's circle VBA code  (0) 2023.06.16
VBA를 사용하여 X 축과 Y 축의 범위 값을 가져오기  (0) 2023.06.14
셀 값이 0인 경우 해당 셀 값 삭제  (0) 2023.02.21
열너비 바꾸는 VBA  (0) 2023.02.20
데이터 정렬하기  (0) 2023.02.17
반응형

선택한 영역에서 셀 값이 0인 경우 해당 값을 삭제하는 VBA 코드

 

Sub DeleteZeroValues()
    Dim rng As Range
    Set rng = Application.InputBox("Select a range of cells", Type:=8)

    If rng Is Nothing Then
        MsgBox "Cancelled", vbInformation
        Exit Sub
    End If
    
    Dim cell As Range
    For Each cell In rng
        If cell.Value = 0 Then
            cell.Value = ""
        End If
    Next cell
End Sub
반응형

'VBA' 카테고리의 다른 글

VBA를 사용하여 X 축과 Y 축의 범위 값을 가져오기  (0) 2023.06.14
엑셀 차트크기 조절 VBA  (0) 2023.04.04
열너비 바꾸는 VBA  (0) 2023.02.20
데이터 정렬하기  (0) 2023.02.17
엑셀VBA 잘하는 방법  (0) 2023.02.08
반응형

엑셀에서 영역을 선택하고 선택한 영역의 홀수열의 너비는 10, 짝수열의 너비는 20으로 만드는 vba

 

ChatGPT가 알려준 VBA Code

Sub SetColumnWidth()
    Dim rng As Range
    Set rng = Selection
    Dim i As Integer
    For i = 1 To rng.Columns.Count
        If i Mod 2 = 1 Then
            rng.Columns(i).ColumnWidth = 10
        Else
            rng.Columns(i).ColumnWidth = 20
        End If
    Next i
End Sub

 

원하는 답변을 얻으려면 질문을 얼마나 정확하게 하느냐가 관건이다.

반응형

'VBA' 카테고리의 다른 글

엑셀 차트크기 조절 VBA  (0) 2023.04.04
셀 값이 0인 경우 해당 셀 값 삭제  (0) 2023.02.21
데이터 정렬하기  (0) 2023.02.17
엑셀VBA 잘하는 방법  (0) 2023.02.08
좌표를 시계방향, 반시계방향으로 정렬  (0) 2023.01.15
반응형

 

A열에 국가명이 있고 B열에는 값이 들어 있다.
국가명이 같은 B열의 값을 세로로 붙여 넣고 싶습니다.

 

네이버 지식인의 답변

 

Sub Macro()
Dim vDB, Rev As Variant
Dim T As String
Dim i As Long
 Application.ScreenUpdating = False
    On Error GoTo ET
   vDB = Range("A3").CurrentRegion.Value
  Range("E1").CurrentRegion.ClearContents
  With CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(vDB)
        T = vDB(i, 1)
      If Not .Exists(T) Then Set .Item(T) = CreateObject("System.Collections.Arraylist")
        With .Item(T)
           .Add vDB(i, 2)
'           .Sort
        End With
    Next i
      Range("E1").Resize(, .Count).Value = .keys
    For i = 0 To .Count - 1
        Rev = .Items()(i).Toarray
      Cells(2, 5).Offset(, i).Resize(UBound(Rev) + 1) = Application.Transpose(Rev)
    Next i
  End With
ET:
End Sub

 

20230216_정렬답변.xlsm
0.02MB

반응형
반응형

엑셀VBA  잘하는 방법

 

  1. VBA 기초 개념 학습: VBA의 기본 개념과 문법을 숙지하여야 합니다.
  2. 레코딩 기능 사용: 엑셀 VBA의 레코딩 기능을 사용하여 간단한 매크로를 생성하여 기초 개념을 익히는 것이 좋습니다.
  3. 코드 읽기: 사용하는 기능의 VBA 코드를 읽고, 이해하는 것이 좋습니다.
  4. 예제 코드 참조: 엑셀 VBA를 사용하는 다양한 예제 코드를 참조하여 기술을 습득하는 것이 좋습니다.
  5. 실습: 자신의 매크로를 작성하고 실행하면서 경험을 쌓아보는 것이 좋습니다.

위와 같은 방법들을 적절히 조합하여 엑셀 VBA 스킬을 길러보세요!

 

 

VBA(Visual Basic for Applications)의 기초 개념으로는 다음과 같은 것이 있습니다:

  1. 변수와 상수: 데이터를 저장하는 공간을 구성하는 기본 단위
  2. 연산자: 데이터를 연산하는 기본 도구
  3. 조건문: 특정 조건을 만족하는지 판단하여 결과를 결정하는 구조
  4. 반복문: 특정 조건을 만족할 때까지 특정 구문을 반복 실행하는 구조
  5. 함수와 프로시저: 재사용 가능한 코드 블록
  6. 이벤트 처리: 사용자의 액션에 따라 특정 동작을 수행하는 구조.

VBA 예제 코드는 Microsoft 공식 문서, 온라인 포럼, 전문 개발자 블로그 등에서 검색할 수 있습니다. 예를 들어, Microsoft Developer Network(MSDN), Stack Overflow, Code Project 등의 웹 사이트를 참고할 수 있습니다. 또한, VBA 강좌를 수강하거나 VBA 전문 개발자와의 상담을 통해 VBA 기초 개념과 실제 코드 작성 기술을 배울 수 있습니다.

 

 

 

반응형
반응형

좌표를 시계방향, 반시계방향으로 정렬

https://www.cadtutor.net/forum/topic/70648-resort-polygon-coordinates-to-nonintersecting-coordinates/

 

resort polygon coordinates to NonIntersecting coordinates

Hi all, I have four coordinates for each polygon in excel, number of some polygons isn't sort and when I draw them in google earth or autocad by vba programming, interference occurs, can we resort them to NonIntersecting coordinates?.: (number of points is

www.cadtutor.net



https://pavcreations.com/clockwise-and-counterclockwise-sorting-of-coordinates/

 

Clockwise and Counterclockwise sorting of 2D coordinates

In this article we'll look into sorting out a list 2D coordinates in a clockwise or counterclockwise direction that will form a closed shape.

pavcreations.com



convexhull
https://www.andypope.info/charts/convexhull.htm

 

Convex hull

 

www.andypope.info

 

반응형
반응형

#NAME? 오류가 발생하는 원인과 해결 방법

 

1.함수를 사용할 때 함수명을 정확히 입력하지 않았을 때 오류가 발생한다.

  엑셀함수는 제대로 입력하면 대문자로 표시되므로 쉽게 확인이 가능하다.

  정확한 함수명을 입력한다.

 

2. module이름과 함수 이름을 같으면 #NAME? 오류가 발생한다.

  module이름과 함수 이름을 다르게 한다.

반응형
반응형

닫힌 다각형의 내부점인지 외부점인지 확인하는 방법

 

Test Whether A Point Is In A Polygon Or Not

 

 

https://excelfox.com/forum/showthread.php/1579-Test-Whether-A-Point-Is-In-A-Polygon-Or-Not

 

Test Whether A Point Is In A Polygon Or Not

Public Function PtInPoly(Xcoord As Double, Ycoord As Double, Polygon As Variant) As Variant Dim x As Long, NumSidesCrossed As Long, m As Double, b As Double, Poly As Variant Poly = Polygon If Not (Poly(LBound(Poly), 1) = Poly(UBound(Poly), 1) And _ Poly(LB

excelfox.com

 

 

 

반응형

'VBA' 카테고리의 다른 글

좌표를 시계방향, 반시계방향으로 정렬  (0) 2023.01.15
#NAME? 오류가 발생하는 원인과 해결 방법  (0) 2023.01.12
RSA Example with Excel  (0) 2022.12.05
하이퍼링크 일괄삭제  (0) 2022.08.04
Maclauric Seires for Exp(x)  (0) 2022.07.12

+ Recent posts