huangyushun 发表于 2016-6-21 13:03:40

源码注释_CDR的VB脚本精确替换_更新_完美支持CDRX8的64位版本！

本帖最后由 huangyushun 于 2017-9-26 12:59 编辑

源码是群里的兴达给的，听说是前方的老版本源码
严重怀疑前方作者是复制官方案例来用，
搞的太复杂，我小白看不懂，只能折腾了半天修改了一个小小的地方。。。

交流QQ群：159154046



'------------------------------------------------------------------------------
Sub tifan()
Dim n As Long
Dim F As Long, Shift As Long
Dim dup1 As ShapeRange
Dim OrigSelection As ShapeRange
Dim X1 As Double, Y1 As Double
Dim xp As Double, yp As Double
Dim SYw As Double, SYh As Double
ActiveDocument.Unit = cdrMillimeter
'------------------------------------------------------------------------------

'判断选中对象为0就。草他麻痹。不干活
n = ActiveDocument.Selection.Shapes.Count
If n = 0 Then
      MsgBox "亲爱的猪头，请先选择需要替换的对象。", vbCritical
      Exit Sub
End If
'------------------------------------------------------------------------------
POSCun = n 'n是选中对象的数量赋值给
'获取选中对象第一个的宽度跟高度给SYwSYh变量
ActiveDocument.Selection.Shapes(1).GetSize SYw, SYh
'重定义数组，n是选中对象的数量，2代表二维数组要记录每个对象的宽度跟高度
ReDim POSdata(n, 2)
'------------------------------------------------------------------------------

'循环把选中的每一个对象的宽度跟高度都记录到数组里
For n = 1 To ActiveDocument.Selection.Shapes.Count
ActiveDocument.Selection.Shapes.Item(n).GetPosition X1, Y1
POSdata(n, 1) = X1
POSdata(n, 2) = Y1
Next

'------------------------------------------------------------------------------
'删除选中的所有对象
ActiveDocument.Selection.Delete


'------------------------------------------------------------------------------
'用一个判断循环来判断用户是否选择了对象
Dim linshi As Boolean
Do
      '让用户去选择用什么对象来替换上面刚才记录的并且删除的所有对象
      linshi = ActiveDocument.GetUserArea(xp, yp, xp, yp, Shift, 1, False, cdrCursorExtPick)
      '判断用户是否选中了一个对象
Loop While ActiveDocument.Selection.Shapes.Count = 0

'------------------------------------------------------------------------------
'把用户选中的对象赋值
Set OrigSelection = ActiveSelectionRange

'------------------------------------------------------------------------------
'循环，次数是用户第一次选中对象的数量
For F = 1 To POSCun
'用第二次选中的对象逐个替换第一次选中的对象
Set dup1 = OrigSelection.Duplicate()
dup1.SetPosition POSdata(F, 1), POSdata(F, 2)
Next
'------------------------------------------------------------------------------
End Sub
'------------------------------------------------------------------------------


poshuixukong 发表于 2016-6-21 16:31:51

向楼主学习:D

poshuixukong 发表于 2016-6-21 16:33:56

完美perfect

新手我也来 发表于 2016-7-8 20:38:05

向楼主学习，希望看到更多的源码。

ww983669829 发表于 2016-7-10 13:36:38

这些都看不懂，能整理想脚本出来吗

no543216789 发表于 2016-10-29 05:28:03

没用过前方，不知道功能，不过代码很短。

A-Ming 发表于 2017-1-4 16:42:00

有人知道这个怎么用么？:'(

上帝也疯狂 发表于 2017-1-4 16:55:54

看不懂啊，亲来的楼主。

jozeyin 发表于 2017-1-11 19:30:12

表示看不懂，只会用，不会做。哈哈。:lol

血七 发表于 2017-1-17 14:11:00

看着眼花。但是实用就行。学这个不知道 要多久才学得会。
页: [1] 2
查看完整版本: 源码注释_CDR的VB脚本精确替换_更新_完美支持CDRX8的64位版本！