A-Ming 发表于 7 天前

VB大佬帮我看下创建出来的十字线，不能群组

Sub 中心点创建的十字线()
    Dim s As Shape
    Dim centerX As Double, centerY As Double
    Dim lineLength As Double
    Dim lineWidth As Double
    Dim horizLine As Shape, vertLine As Shape
    ActiveDocument.Unit = cdrMillimeter
    ' 设置参数
    lineLength = 10
    lineWidth = 0.3

    ' 检查是否有选中的对象
    If ActiveSelection.Shapes.Count = 0 Then
      MsgBox "请先选择一个对象", vbExclamation, "错误"
      Exit Sub
    End If

    ' 获取第一个选中对象的中心点
    Set s = ActiveSelection.Shapes(1)
    centerX = s.CenterX
    centerY = s.CenterY

    ' 创建水平线
    Set horizLine = ActiveLayer.CreateLineSegment(centerX - lineLength / 2, centerY, centerX + lineLength / 2, centerY)
    horizLine.Outline.SetPropertiesEx lineWidth,lineLength, OutlineStyles(0), CreateCMYKColor(1, 2, 3, 30), ArrowHeads(0), ArrowHeads(0), cdrFalse, cdrFalse, cdrOutlineButtLineCaps, cdrOutlineMiterLineJoin, 0#, 100, MiterLimit:=5#, Justification:=cdrOutlineJustificationMiddle

    ' 创建垂直线
    Set vertLine = ActiveLayer.CreateLineSegment(centerX, centerY - lineLength / 2, centerX, centerY + lineLength / 2)
    vertLine.Outline.SetPropertiesEx lineWidth, lineLength , OutlineStyles(0), CreateCMYKColor(1, 2, 3, 100), ArrowHeads(0), ArrowHeads(0), cdrFalse, cdrFalse, cdrOutlineButtLineCaps, cdrOutlineMiterLineJoin, 0#, 100, MiterLimit:=5#, Justification:=cdrOutlineJustificationMiddle


    ' 将新创建的十字线组合
    ActiveSelection.Shapes.All.CreateGroup


End Sub

A-Ming 发表于 7 天前

' 将新创建的十字线组合
    ActiveSelection.Shapes.All.CreateGroup:(   是不是要创建选择，还是要移到活跃层到才行？

夜的影子 发表于 6 天前

你创建了形状，也没选中啊，默认选中的是最新创建的那一个，前一个就取消选择了。
直接添加到ShapeRange，然后群组试试，不行的话，至少先同时选中，然后再群组吧。

夜的影子 发表于 6 天前

' 将新创建的十字线组合
    ActiveSelection.Shapes.All.CreateGroup

改成：
    horizLine.Selected = True       '刚创建的垂直线本身已经是选择的了。现在把水平线再选择   
    ActiveSelectionRange.Group   ' 把选择范围都组合，将新创建的十字线组合
页: [1]
查看完整版本: VB大佬帮我看下创建出来的十字线，不能群组