cdr页面图形增加编码数字编号脚本插件

fengyelin

joyar 发表于 2023-8-18 11:48
生成好的数字，，调整文字大小，，是以左下角为准的，，如何以居中形式修改文字大小 ...

用魔镜这个功能`如果你没装魔镜就到网上几块买个低配版的就有,或者用楼上兄台那代码

fengyelin

joyar 发表于 2023-8-18 12:27
明白了，，理解怎么去玩了。。

这个代码其实对平时工作很少用到,适合给拼图做标记,这样位置不会乱,或者队列做标记

vipjm

fengyelin 发表于 2023-8-18 12:31
这个代码其实对平时工作很少用到,适合给拼图做标记,这样位置不会乱,或者队列做标记 ...

是的，就是大小不一的这个就是对应号去放上去。

vipjm

jiangyu 发表于 2023-8-18 08:44
Sub CreateArtisticTextInCenter()

Dim s As Shape

兄弟能不能直接弄成一个gms，相信有很多人一样跟我不懂代码。给我们代码我们不会弄成按键呀。

jiangyu

vipjm 发表于 2023-8-18 14:27
兄弟能不能直接弄成一个gms，相信有很多人一样跟我不懂代码。给我们代码我们不会弄成按键呀。 ...

这个插件没有使用窗体，只是一个单功能，使用时可以拖到菜单栏作为单独按钮，也可设置快捷键一键操作。使用2022.5版本cdr制作，应该不兼容X4等低版本，下面附上源码，使用X4的朋友可以自行拷贝到VBA中制作插件。
该插件是使用默认字体与字号生成文本，文本填色为文档默认填色。可以先修改文档默认字体与字号再使用该插件，可以一次性制作完成。修改默认字体字号的方法是按F8后修改字体或字号，在弹出窗口中选择美术字并确认。

Sub 编号()
ActiveDocument.BeginCommandGroup "编号"

Dim s As Shape

Dim i As Integer


i = 1

' 遍历选中的形状
For Each s In ActiveSelectionRange
    ' 获取形状的中心坐标
    Dim centerX As Double
    Dim centerY As Double
   
    centerX = s.centerX
    centerY = s.centerY
   
    ' 创建艺术字形状，并设置文本内容为数字
    Dim textShape As Shape
    Set textShape = ActiveLayer.CreateArtisticText(centerX, centerY, i)
   
    If textShape.SizeWidth > s.SizeWidth * 0.85 Then
    textShape.SizeWidth = s.SizeWidth * 0.85
    End If

    textShape.centerX = s.centerX
    textShape.centerY = s.centerY

i = i + 1

Next s
ActiveDocument.EndCommandGroup
End Sub


这是放在模块里面的：
新建一个模块，复制进去就可以了。

vipjm

jiangyu 发表于 2023-8-19 09:36
这个插件没有使用窗体，只是一个单功能，使用时可以拖到菜单栏作为单独按钮，也可设置快捷键一键操作。使 ...

刚测试了，序码全部居中了。

vipjm

如果不同的图形，它的序号就有点乱了。从左往右的规则好像有点乱了。

fengyelin

vipjm 发表于 2023-8-19 16:49
如果不同的图形，它的序号就有点乱了。从左往右的规则好像有点乱了。
...

这个代码是依照你图形创造的时间顺序，没有加入z排列

vipjm

哦，原来这样，明白。。。。。。