3圆相切的问题

wb_1027

一般气泡有三个纬度，散点两个纬度，不相容
这里偷个巧



输入函数   =IF(H7=1,COS(RADIANS(I7))*$N$3+$B$32,IF(H7=2,$C$41,"*"))
即辅助1、2、3的行次分别为圆，圆心，标记符
通过筛选标记符，将辅助为3的行次清成真空（不是删除）
（非真空类似于正弦曲线）
即将圆的半径全部做出来（圆2为例）



通过调整半径的宽度，达到填满整个圆的效果



端点为 平面 即可

493861364

wb_1027 发表于 2021-7-22 10:20
一般气泡有三个纬度，散点两个纬度，不相容
这里偷个巧

看了半天才想明白，思路很独到，从圆心到圆上做直线散点图，然后加粗，形成圆，规避了气泡图大小不好控制的问题，
相当于把一个气泡图的问题转化为一个散点图的问题，这样能实现精确作图了

micch

如果是线条堆积，可以不用考虑中间断开，就用首尾相连的方式做一个散点连线就行

1. =$E$5*COS(RADIANS(ROW()/2)-1)*MOD(ROW(),2)+$F$5

复制代码

1. =$E$5*SIN(RADIANS(ROW()/2)-1)*MOD(ROW(),2)+$G$5

复制代码

493861364

觉得散点图就是万能的，气泡图都能用散点图做了，沿着这条思路用散点图应该还能模拟玫瑰图，雷达图，有空试试看能不能做出来

493861364

wb_1027 发表于 2021-7-22 10:20
一般气泡有三个纬度，散点两个纬度，不相容
这里偷个巧

学习楼上这位老师的作图思路，照着弄了一个

wb_1027

493861364 发表于 2021-7-22 18:08
学习楼上这位老师的作图思路，照着弄了一个

Sub ScalePlot()
    Dim Cht As Chart, Ser As Series, AxX As Axis, AxY As Axis
    Dim XVals, YVals, MinX, MinY, MaxX, MaxY
    Dim i
    Dim PWd, PHt, PWd1, PHt1
    Dim XDiff, YDiff, XDiff1, YDiff1
    Dim Buffer
    Dim WdScale, HtScale
    Set Cht = ActiveChart
    With Cht
        For i = 1 To Cht.SeriesCollection.Count
            Set Ser = Cht.SeriesCollection(i)
            XVals = Ser.XValues
            YVals = Ser.Values
            If i = 1 Then
                MinX = WorksheetFunction.Min(XVals)
                MaxX =WorksheetFunction.Max(XVals)
                MinY =WorksheetFunction.Min(YVals)
                MaxY =WorksheetFunction.Max(YVals)
            Else
                MinX =WorksheetFunction.Min(MinX, XVals)
                MaxX =WorksheetFunction.Max(MaxX, XVals)
                MinY =WorksheetFunction.Min(MinY, YVals)
                MaxY =WorksheetFunction.Max(MaxY, YVals)
            End If
        Next
        With .PlotArea
            .Top = 0
            .Left = 0
            .Width = Cht.ChartArea.Width
            .Height = Cht.ChartArea.Height
            PWd = .Width
            PHt = .Height
            PWd1 = .InsideWidth
            PHt1 = .InsideHeight
        End With
        Set AxX = .Axes(xlCategory)
        Set AxY = .Axes(xlValue)
        XDiff = MaxX - MinX
        YDiff = MaxY - MinY
        Buffer = 0.1
        MaxX = MaxX + Buffer * XDiff
        MinX = MinX - Buffer * XDiff
        MaxY = MaxY + Buffer * YDiff
        MinY = MinY - Buffer * YDiff
        XDiff = MaxX - MinX
        YDiff = MaxY - MinY
        With AxX
            .MaximumScale = MaxX
            .MinimumScale = MinX
        End With
        With AxY
            .MaximumScale = MaxY
            .MinimumScale = MinY
        End With
        WdScale = PWd1 / XDiff
        HtScale = PHt1 / YDiff
        If WdScale > HtScale Then
            XDiff1 = (XDiff * WdScale / HtScale- XDiff) / 2
            AxX.MinimumScale = MinX - XDiff1
            AxX.MaximumScale = MaxX + XDiff1
        Else
            YDiff1 = (YDiff * HtScale / WdScale- YDiff) / 2
            AxY.MinimumScale = MinY - YDiff1
            AxY.MaximumScale = MaxY + YDiff1
        End If
    End With
End Sub

抄来的代码，我不懂
可以自动修正图表比例为1：1



调整后

micch

只要图表高宽是相等的，横纵坐标最大最小差值是相同的，就我1:1.

493861364

wb_1027 发表于 2021-7-22 21:29
Sub ScalePlot()
    Dim Cht As Chart, Ser As Series, AxX As Axis, AxY As Axis
    Dim XVals, YVa ...

一致在找读取图表系列数据的值的语句，赚大发了

dengxingchang

wb_1027 发表于 2021-7-22 21:29
Sub ScalePlot()
    Dim Cht As Chart, Ser As Series, AxX As Axis, AxY As Axis
    Dim XVals, YVa ...

次坐标加一个饼图（填充不可见颜色），就会强制1:1

493861364

dengxingchang 发表于 2021-7-23 10:23
次坐标加一个饼图（填充不可见颜色），就会强制1:1

邓老师这个办法也挺好的，试了试，确实可以，应该是饼图把绘图区强制改成长宽一致了