fengyelin 发表于 2023-9-14 22:04
陈哥有没有可以自动给异形中心画最大内切圆`
数学学的不是很好。不知道怎么计算的，很多公式都不会用了。你要是把计算过程发给我，我可以帮你转代码化，也许能成功。应该很复杂。多边形已经很复杂了。要是再带弧线，应该就更复杂了吧。这方面没有什么研究。
绿草地 发表于 2023-9-14 21:08
最近时间少，基本功能已经实现。还在调试中，你发个你常用的图上来，我有空测试测试。 ...
陈哥，你好，文件有点大，只能这样上传了.链接：https://pan.baidu.com/s/15H9SKPL7GOBN8TKX_CoA5w?pwd=6jry
提取码：6jry
绿草地 发表于 2023-9-14 22:21
数学学的不是很好。不知道怎么计算的，很多公式都不会用了。你要是把计算过程发给我，我可以帮你转代码化 ...
Dim Pi As Double: Pi = 4 * Atn(1)
ActiveDocument.Unit = cdrMillimeter
Dim s1 As Shape, i As Integer, pA, pB, pC, pD, O, arrP(72)
Set s1 = ActiveSelectionRange.Shapes(1)
Dim p(): ReDim p(s1.Curve.Nodes.Count - 1)
For i = 0 To UBound(p)
p(i) = Array(s1.Curve.Nodes(i + 1).PositionX, s1.Curve.Nodes(i + 1).PositionY)
Next
Dim gama As Double, gama0 As Double, u As Double, v As Double
-- centre O
pA = Array(p(0)(0) + 0.5 *(p(1)(0) -p(0)(0)), p(0)(1) + 0.5 * (p(1)(1) -p(0)(1)))
pB = Array(p(3)(0) + 0.5 *(p(2)(0)-p(3)(0)), p(3)(1) + 0.5 *(p(2)(1)-p(3)(1)))
pC = Array(p(0)(0) + 0.5 * (p(3)(0) - p(0)(0)), p(0)(1) + 0.5 * (p(3)(1) - p(0)(1)))
pD = Array(p(1)(0)+ 0.5 *(p(2)(0) -p(1)(0)), p(1)(1)+ 0.5 *(p(2)(1)-p(1)(1)))
O = math.segsCross(pA, pB, pC, pD)
---- getting gama0 (i.e. pD) ----
u = 0.5 + 0.5 * Cos(0):v = 0.5 +0.5 * Sin(0)
pD = Array(p(1)(0) + v *(p(2)(0)-p(1)(0)),p(1)(1) + v *(p(2)(1)-p(1)(1)))
gamaO = math.alfaPP_inArc(pD, O)
start
Fori = 0 To 72
gama =i*5*(Pi/180)
u = 0.5 + 0.5 * Cos(gama - gama0)
v = 0.5 + 0.5 * Sin(gama - gama0)
pA = Array(p(0)(0) + u * (p(1)(0) - p(0)(0)), p(0)(1) + u * (p(1)(1) - p(0)(1)))
pB = Array(p(3)(0) + u * (p(2)(0) - p(3)(0)), p(3)(1) + u * (p(2)(1) - p(3)(1)))
pC =Array(p(0)(0) + v*(p(3)(0) -p(0)(0)),p(0)(1) +v*(p(3)(1)-p(0)(1)))
pD = Array(p(1)(0) + v * (p(2)(0) -p(1)(0)), p(1)(1) + v * (p(2)(1) - p(1)(1)))
arrP(i) = math.segsCross(pA, pB, pC, pD)
Next
Set s1 = draw.BezierX(arrP)
这段代码可以在多边形做内切圆,但我看不懂怎么运行
流雲 发表于 2023-9-15 09:21
陈哥，你好，文件有点大，只能这样上传了.链接：https://pan.baidu.com/s/15H9SKPL7GOBN8TKX_CoA5w?pwd=6 ...
巡边功能，已经测试完成，有问题的地方也作了说明 ，你自己看一下。现在已发新贴。你去看看吧。
fengyelin 发表于 2023-9-15 17:34
Dim Pi As Double: Pi = 4 * Atn(1)
ActiveDocument.Unit = cdrMillimeter
Dim s1 As Shape, i As Intege ...
测试了这段代码，代码不全，重要的2个函数没有：math.segsCross(pA, pB, pC, pD)，draw.BezierX(arrP)，这里它有2个函数调用。所以我也无能为力了。找landboy 兰雅大神看看，他应该是可以了。
绿草地 发表于 2023-8-27 18:35
花费了几天的空闲时间
今天终于测试完成。
怎么我的X6用不到编号插件呀？
我的X4只能用编号，X6只能用序号:Q
samupday 发表于 2023-9-18 16:19
我的X4只能用编号，X6只能用序号
我用X4，6测试都是没有问题，不知道你出错，是哪个地方。报错还是没有反应。可以截图或录一下发上来看看。看看你的操作对不对。再读一下功能说明。一定要正常操作。
绿草地 发表于 2023-9-18 21:03
我用X4，6测试都是没有问题，不知道你出错，是哪个地方。报错还是没有反应。可以截图或录一下发上来看看 ...
今天重新试过，又行了。
有全功能的没，兄弟们有的吗？