金山词霸音标13版转换成14版并提供含音标单词库

wjhere

金山词霸音标（IPA 13版）转换为（IPA 14版）发布

从这篇帖子你可以获得：
1、本人整理的22500单词含音标单词库（含新旧版本音标）
2、在word和excel中把金山词霸音标（IPA 13版）转换为（IPA 14版）的函数和过程
3、标注以上音标的字体KsphonetE.ttf显示为“KPP Edition 2008教师节”

首先感谢sylun的大力支持和热心帮助，是他帮忙解决了在word中处理的主要问题，促成了这篇帖子的发布。

这些可是本人近半个月的劳动成果，如果效果还行，别忘顶一顶。最好能给个精华。我都混了几年了，还没有像样的作品。真的感觉对不起论坛上热心朋友的帮助和培养。欢迎大家提出宝贵意见。

因为或的金山词霸音标的途径很多，守柔版主曾今做过，我在整理单词库的时候部分单词就用到了他的程序。源思音标大师功能也很强大，但未注册有限制。提供整理好的单词库，希望有兴趣的同志可以做一个不需要金山词霸支持的来。最好做出了可以支持智能识别s,es,ed,er,ing等后缀的。
因为现在的中小学教材大多使用的是IPA 14版音标。我们牛津小学英语就是，所以就有了转换音标的想法，金山词霸字体中已经包含了IPA 14版音标的大多数符号，就添加了一个缺少的符号，因为是教师节前夕完成修改，取名为KsphonetE.ttf显示为“KPP Edition 2008教师节”

下载字体并安装，源码包含在测试文件中，下载测试文件进行测试

建议一次处理的音标不要太多，在word中不要多于10页，excel中可以显示进度，处理20000多没有问题。

单词库稍大，请到网盘下载：http://wjhere.ys168.com
接受sylun兄的指导，9月15日晚作了修改：

[ 本帖最后由 wjhere 于 2008-11-11 22:36 编辑 ]

守柔

这是一个好贴，楼主用心良苦，特别是整理出了22500个单词，释义和两种音标格式，有了它，可以摆脱金山词霸的束缚（具体金山词霸有多少单词我没有为数）。

感谢wjhere！

sylun

谢谢楼主分享！

wjhere

多谢两位的支持，没少麻烦两位。厚着脸皮要，竟然被版主批准了。平生第一个精华帖，受宠若惊，可喜可贺。正如这中秋的明月。

wjhere

根据sylun兄的指导，对过程做了修改，速度有了很大提高：

'感谢sylun兄对金山词霸字体转换成ascii字符主要过程的提供,并多次修改至此
'本程序用于在word中把金山词霸标注音(旧版国际音标(IPA 13版))标转换成新版国际音标(IPA 14版)
'需要调用函数newPtc转换音标

Sub KSPP2newKSPP1()
Dim a As String
Dim s As Long
Application.ScreenUpdating = False
With ActiveDocument.Content.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "[" & ChrW(61480) & "-" & ChrW(61565) & "]{1,}"
    .MatchWildcards = True
    Do While .Execute
        a = .Parent.Text
        For i = 1 To VBA.Len(a)
            a = VBA.Replace(a, Mid(a, i, 1), ChrW(AscW(Mid(a, i, 1)) + 4096), , 1)
        Next
        With .Parent
            .Text = newPtc(a) '调用函数
            '.Font.Name = "KPP Edition 2008教师节"
            .Collapse wdCollapseEnd
        End With
    Loop
End With
 With ActiveDocument.Content.Find
    .Font.Name = "Kingsoft Phonetic Plain"
    .Replacement.Font.Name = "KPP Edition 2008教师节"
    .Format = True
    .Execute Replace:=wdReplaceAll
End WithApplication.ScreenUpdating = True
End Sub

函数也做了精简：

'该函数用于把金山词霸标注音(旧版国际音标(IPA 13版))标转换成新版国际音标(IPA 14版)
'在excel中可以直接使用，在word中需要另一模块的支持才能正常转换
'使用本函数需要安装字体：“KPP Edition 2008教师节”这是金山词霸字体的修改版
'在字体中添加了必须字符一个字符
'实质上就是两种音标系统对应字符的替换
'本函数由wjhere制作，欢迎交流： wjhere@126.com，转载请注明
'因为我是业余的，请各位大侠指教，修改精简以提高速度
Public Function newPtc(oldPtc As String) As String

Dim cZiFu, nZiFu As String '用于取得音标中的当前字符与下一个字符
Dim zfPos As Integer '当前字符位置
Dim a As Integer, b As Integer
Do
    a = InStr(1, oldPtc, "C")
    b = InStr(1, oldPtc, "R")
    If a Then If Mid(oldPtc, a + 1, 1) Like "[!:i]" Then Mid(oldPtc, a, 1) = "D" Else a = 0
    If b Then If Mid(oldPtc, b + 1, 1) Like "[!:i]" Then Mid(oldPtc, b, 1) = "D" Else b = 0
Loop Until a = 0 And b = 0

For i = 1 To Len(oldPtc)
cZiFu = Mid(oldPtc, i, 1)
If i < Len(oldPtc) Then nZiFu = Mid(oldPtc, i + 1, 1)
If StrComp(nZiFu, ":", vbTextCompare) <> 0 Then
'MsgBox cZiFu
zfPos = InStr(1, "iu", cZiFu, vbTextCompare)
If zfPos > 0 Then

oldPtc = Left(oldPtc, i - 1) & Replace(oldPtc, cZiFu, Mid("IJ", zfPos, 1), i, 1, vbTextCompare)
End If
End If
Next

oldPtc = Replace(oldPtc, "ZE", "eE")
oldPtc = Replace(oldPtc, "E:", "\:")

newPtc = oldPtc
End Function

liurulin

虽然不懂英语，还是谢谢楼主的辛勤劳动

wq_lbj

好东西，最近我正在做一个单词表，并做成数据库，由此生成背单词的卡片，如果大家有可拿出共享，如没有，我准备自已做，做好后，会上传的，我们一起努力，共同进步。

何铁江

不好意思,这个怎么用请请教一下.

ccidnet

QUOTE:

以下是引用wq_lbj在2008-10-5 11:41:00的发言：
好东西，最近我正在做一个单词表，并做成数据库，由此生成背单词的卡片，如果大家有可拿出共享，如没有，我准备自已做，做好后，会上传的，我们一起努力，共同进步。

我用一个笨办法,将单逐个录入表格,用词霸加入生字本,再用卡片打印就行了.

[em04]

tony@cq

正需要这东西，谢谢