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

huangyushun

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

交流QQ群：159154046


[mw_shl_code=vb,true]
'------------------------------------------------------------------------------
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是选中对象的数量赋值给
'获取选中对象第一个的宽度跟高度给SYw  SYh变量
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
'------------------------------------------------------------------------------
[/mw_shl_code]

poshuixukong

向楼主学习

poshuixukong

完美perfect

新手我也来

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

ww983669829

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

no543216789

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

A-Ming

有人知道这个怎么用么？

上帝也疯狂

看不懂啊，亲来的楼主。

jozeyin

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

血七

看着眼花。但是实用就行。学这个不知道 要多久才学得会。