相同颜色填充、轮廓曲线结合

ggcupp

学习的第一个cpg插件，delphi 编写的是在delphi框架的基础上实现的一个实例 Color_join.rar (510.49 KB)

2016-11-16 22:21 上传

点击文件名下载附件

。


补充内容 (2016-11-17 18:19):
begin
  FApp.ActiveDocument.Unit_ := CDRMillimeter;
  if FApp.ActiveLayer.Shapes.Count = 0 then
  begin
    MessageBox(0, '图层为空', '提示', MB_OK);
    exit;
  end;
  FApp.ActiveWindow.Refresh;
...

补充内容 (2016-11-17 18:21):
var
  st: string;
  st1: string;
  sh: Shape;
  sr1: ShapeRange;
  js: Integer;
  t: Integer;
  n: Integer;
  i: Integer;
label
  n1, n2;

补充内容 (2016-11-17 18:39):
同颜色曲线合并的源码7楼！

taoha008

跟增强选择一样吧

huayingshenqu00

先整个下看用用，通用的不分版本么

w19238103

先下载用用看，楼主这么做肯定有他独到的地方

魔星星

试试看能不能提高效率。

no543216789

又是delphi编写的，牛啊，代码能不能看一下呢

ggcupp

添加到cpg框架里的窗体，增加一个按钮，复制到按钮单击就可以了，实现同颜色曲线合并的功能！
实现了基本的vba转成cpg插件的功能。
procedure TForm1.btn1Click(Sender: TObject);
var
  st: string;
  st1: string;
  sh: Shape;
  sr1: ShapeRange;
  js: Integer;
  t: Integer;
  n: Integer;
  i: Integer;
label
  n1, n2;
begin
  FApp.ActiveDocument.Unit_ := cdrMillimeter;
  if FApp.ActiveLayer.Shapes.Count = 0 then
  begin
    MessageBox(0, '图层为空', '提示', MB_OK);
    exit;
  end;
  FApp.ActiveWindow.Refresh;
  FApp.ActiveDocument.BeginCommandGroup('rename');
  FApp.Optimization := True;
  js := 1;
  i := FApp.ActiveLayer.Shapes.Count;
n1:
  sr1 := FApp.CreateShapeRange;
  if FApp.ActiveLayer.Shapes[js].type_ = cdrCurveShape then
  begin
    st := FApp.ActiveLayer.Shapes[js].Outline.Color.Name[True];
    if (st = 'R: 0 G: 0 B: 0') or (st = '') or (st = 'R: 255 G: 0 B: 0') or (st = 'C: 0 M: 0 Y: 0 K: 100') or (st = 'C: 0 M: 100 Y: 100 K: 0') then
    begin
      if js < FApp.ActiveLayer.Shapes.Count then
      begin
        js := js + 1;
        goto n1;
      end;
    end;
    n := FApp.ActiveLayer.Shapes.Count;
    if js = n then
    begin
      MessageBox(0, '绘制完成！', '提示', MB_OK);
      goto n2;
    end;

[sell=1]for t := js to n do
    begin
      st1 := FApp.ActiveLayer.Shapes[t].Outline.Color.Name[True];
      if st1 = st then
        sr1.Add(FApp.ActiveLayer.Shapes[t]);
      if t = n then
      begin
        if sr1.Count >= 2 then
          sh := sr1.Combine;
        sr1 := nil;
        js := js + 1;
        if js > FApp.ActiveLayer.Shapes.Count then
        begin
          MessageBox(0, '绘制完成！', '提示', MB_OK);
          goto n2;
        end;
        goto n1;
      end;
    end;
  end
  else
  begin
    if js < FApp.ActiveLayer.Shapes.Count then
    begin
      js := js + 1;
      goto n1;
    end;
  end;
  if sr1.Count >1 then
  begin
    sr1.Combine;
    MessageBox(0, '绘制完成！', '提示', MB_OK);
  end;
n2:
  if i = FApp.ActiveLayer.Shapes.Count then
    MessageBox(0, '激活层无满足条件的对象！', '提示', MB_OK);
  FApp.Optimization := False;
  FApp.ActiveDocument.EndCommandGroup;
  FApp.ActiveWindow.Refresh;
  FApp.Application.Refresh;

[/sell]
end;

ggcupp

同颜色曲线合并的源码7楼！

存心

CPG格式的插件，值得欢呼！

存心

希望下次写CPG时向你请教一下