周易学了一段时间了，今天来分享一个针对梅花易起卦的辅助小算法。前提是，读者需要有一定的周易业务知识。
网站建设哪家好，找创新互联建站！专注于网页设计、网站建设、微信开发、成都小程序开发、集团企业网站建设等服务项目。为回馈新老客户创新互联还提供了阜阳免费建站欢迎大家使用！
直奔主题，下面是我整理消化总结的一张图：
参考地址:http://www.quanxue.cn/QT_XiaoYa/YiJing/YiJing06.html
$keys = [
[
"坤为地",
"地天泰",
"地泽临",
"地火明夷",
"地雷复",
"地风升",
"地水师",
"地山谦"
],
[
"天地否",
"乾为天",
"天泽履",
"天火同人",
"天雷无妄",
"天风姤",
"天水讼",
"天山遁"
],
[
"泽地萃",
"泽天夬",
"兑为泽",
"泽火革",
"泽雷随",
"泽风中孚",
"泽水困",
"泽山咸"
],
[
"火地晋",
"火天大有",
"火泽睽",
"离为火",
"火雷噬嗑",
"火风鼎",
"火水未济",
"火山旅"
],
[
"雷地豫",
"雷天大壮",
"雷泽归妹",
"雷火丰",
"震为雷",
"雷风恒",
"雷水解",
"雷山小过"
],
[
"风地观",
"风天小畜",
"风泽中孚",
"风火家人",
"风雷益",
"巽为风",
"风水涣",
"风山渐"
],
[
"水地比",
"水天需",
"水泽节",
"水火既济",
"水雷屯",
"水风井",
"坎为水",
"水山旅"
],
[
"山地剥",
"山天大畜",
"山泽损",
"山火贲",
"山雷颐",
"山风蛊",
"山水蒙",
"艮为山"
]];
$binary_keys = [0x0, 0x7, 0x3, 0x5, 0x1, 0x6, 0x2, 0x4];
function validate($value)
{
return true;
}
function generateDiagrams($a, $b, $c)
{
global $keys, $binary_keys;
$diagrams = $sDiagrams = $hDiagrams = $bDiagrams = '';
if (validate([$a, $b, $c])) {
$a %= 8;
$b %= 8;
$c = $c % 6 === 0 ? 6 : $c % 6;
//本卦
$sDiagrams = $keys[$a][$b];
/**
* 互卦
* 上卦 3 4 5 爻
* 下卦 2 3 4 爻
*/
$diagrams = $binary_keys[$a] << 3 | $binary_keys[$b];
$upDiagramsKey = (0x1C & $diagrams) >> 2;
$downDiagramsKey = ($diagrams & 0xE) >> 1;
list($up_key, $down_key) = findKeyFromBinaryKeys($upDiagramsKey, $downDiagramsKey);
if ($up_key && $down_key) {
$hDiagrams = $keys[$up_key][$down_key];
}
//变爻
$diagrams = $diagrams ^ (0x1 << ($c - 1));
$upDiagramsKey = $diagrams >> 3;
$downDiagramsKey = $diagrams & 0x7;
list($up_key, $down_key) = findKeyFromBinaryKeys($upDiagramsKey, $downDiagramsKey);
if ($up_key && $down_key) {
$bDiagrams = $keys[$up_key][$down_key];
}
}
return [$sDiagrams, $hDiagrams, $bDiagrams];
}
function findKeyFromBinaryKeys($upKey, $downKey)
{
global $binary_keys;
return [array_search($upKey, $binary_keys), array_search($downKey, $binary_keys)];
}
var_dump(generateDiagrams(43, 82, 56));Sub 梅花易起卦()
Dim keys(8, 8) As String
keys(0, 0) = "坤为地"
keys(0, 1) = "地天泰"
keys(0, 2) = "地泽临"
keys(0, 3) = "地火明夷"
keys(0, 4) = "地雷复"
keys(0, 5) = "地风升"
keys(0, 6) = "地水师"
keys(0, 7) = "地山谦"
keys(1, 0) = "天地否"
keys(1, 1) = "乾为天"
keys(1, 2) = "天泽履"
keys(1, 3) = "天火同人"
keys(1, 4) = "天雷无妄"
keys(1, 5) = "天风姤"
keys(1, 6) = "天水讼"
keys(1, 7) = "天山遁"
keys(2, 0) = "泽地萃"
keys(2, 1) = "泽天夬"
keys(2, 2) = "兑为泽"
keys(2, 3) = "泽火革"
keys(2, 4) = "泽雷随"
keys(2, 5) = "泽风中孚"
keys(2, 6) = "泽水困"
keys(2, 7) = "泽山咸"
keys(3, 0) = "火地晋"
keys(3, 1) = "火天大有"
keys(3, 2) = "火泽睽"
keys(3, 3) = "离为火"
keys(3, 4) = "火雷噬嗑"
keys(3, 5) = "火风鼎"
keys(3, 6) = "火水未济"
keys(3, 7) = "火山旅"
keys(4, 0) = "雷地豫"
keys(4, 1) = "雷天大壮"
keys(4, 2) = "雷泽归妹"
keys(4, 3) = "雷火丰"
keys(4, 4) = "震为雷"
keys(4, 5) = "雷风恒"
keys(4, 6) = "雷水解"
keys(4, 7) = "雷山小过"
keys(5, 0) = "风地观"
keys(5, 1) = "风天小畜"
keys(5, 2) = "风泽中孚"
keys(5, 3) = "风火家人"
keys(5, 4) = "风雷益"
keys(5, 5) = "巽为风"
keys(5, 6) = "风水涣"
keys(5, 7) = "风山渐"
keys(6, 0) = "水地比"
keys(6, 1) = "水天需"
keys(6, 2) = "水泽节"
keys(6, 3) = "水火既济"
keys(6, 4) = "水雷屯"
keys(6, 5) = "水风井"
keys(6, 6) = "坎为水"
keys(6, 7) = "水山旅"
keys(7, 0) = "山地剥"
keys(7, 1) = "山天大畜"
keys(7, 2) = "山泽损"
keys(7, 3) = "山火贲"
keys(7, 4) = "山雷颐"
keys(7, 5) = "山风蛊"
keys(7, 6) = "山水蒙"
keys(7, 7) = "艮为山"
Dim binary_keys(8) As Integer
binary_keys(0) = &H0
binary_keys(1) = &H7
binary_keys(2) = &H3
binary_keys(3) = &H5
binary_keys(4) = &H1
binary_keys(5) = &H6
binary_keys(6) = &H2
binary_keys(7) = &H4
A = Sheet1.Range("H16").Value Mod 8
B = Sheet1.Range("I16").Value Mod 8
C = Sheet1.Range("J16").Value Mod 6
If (Not (CBool(C Xor 0))) Then
C = 6
End If
'本卦
Sheet1.Range("H21").Value = keys(A, B)'互卦'下卦 2 3 4 爻'上卦 3 4 5 爻
diagrams = binary_keys(A) * 2 ^ 3 Or binary_keys(B)
upDiagramsKey = (&H1C And diagrams) / 2 ^ 2
downDiagramsKey = (diagrams And &HE) / 2 ^ 1
For i = 0 To UBound(binary_keys) - 1If (Not (CBool(binary_keys(i) Xor upDiagramsKey))) Then
up_key = i
End IfIf (Not (CBool(binary_keys(i) Xor downDiagramsKey))) Then
down_key = i
End IfNext i
Sheet1.Range("I21").Value = keys(up_key, down_key)
'变爻
diagrams = diagrams Xor (&H1 * 2 ^ (C - 1))
upDiagramsKey = diagrams / 2 ^ 3
downDiagramsKey = diagrams And &H7
For i = 0 To UBound(binary_keys) - 1If (Not (CBool(binary_keys(i) Xor upDiagramsKey))) Then
up_key = i
End IfIf (Not (CBool(binary_keys(i) Xor downDiagramsKey))) Then
down_key = i
End IfNext i
Sheet1.Range("J21").Value = keys(up_key, down_key)
End Subhttp://www.quanxue.cn/
