suppresshige.csc

 Corel Users' Club/Graphicsメーリングリストで生まれた「プロジェクト・コーレルスクリプトでポン」略してPCSPon!、ピーシーすぽん! 第3弾
 選択したテキストからステップ1、間隔1mmの等高線を作成し、縁取りを作成します。この際、文字によっては輪郭ペンプロパティでは調整不可能なとげ、ひげが生じる場合がありますので、オブジェクトサイズより等高線幅だけ大きな四角より飛び出した部分を切り取ってしまいます。
 縁取りになるオブジェクトと元のアートテキストの並びを逆順にしますが、色は操作しません。実行後適当に変更してください。


'PCS Pon!
'supress Hige(contour line)
'Copyright by Albatross
'Ver 1.00 2000/11/14
'等高線で輪郭を作ったときにひげが出てしまうのを自動でカットするスクリプト
'等高線のステップは1、間隔は1mm(0.1cm)にスクリプト中で固定


'includeファイルのフォルダが異なる場合は以下の文を有効にしてパスを記入すること。
'#addfol  ".\scripts"
#include "ScpConst.csi"
#include "DrwConst.csi"

dim oid as long, rid as long,clid as long 
dim xp as long,yp as long, xs as long, ys as long
dim os as long

'等高線間隔を変更したい場合は以下の「0.1」を変更すること
os=LENGTHCONVERT(2,7,0.1)

WITHOBJECT "CorelDraw.Automation.9"

    if .isselection()=false then
        message "オブジェクトが選択されていません"
        stop
    endif

'get object properties
    sot =.getobjecttype()
    if sot<>DRAW_OBJECT_TYPE_TEXT% then
        message "選択されているオブジェクトはアートテキストではありません"
        stop
    endif

    .SuppressPainting false
    oid =.GetObjectsCDRStaticID()
    .GetPosition xp,yp
    .GetSize xs, ys
    .ApplyContour 2, os, 1, 0
    .Separate 
    clid =.GetObjectsCDRStaticID()

    .CreateRectangle yp+os, xp-os, yp-ys-os, xp+xs+os, 0, 0, 0, 0
    rid =.GetObjectsCDRStaticID()

    .AppendObjectToSelection clid

    .Intersection false, false
    .AppendObjectToSelection oid

    .OrderReverseOrder
    .ResumePainting 
END WITHOBJECT

<<戻る