1 Star 0 Fork 30

夜空中最亮的星2018/AutoLispBaseFunctionLibrary

加入 Gitee
与超过 1200万 开发者一起发现、参与优秀开源项目,私有仓库也完全免费 :)
免费加入
文件
克隆/下载
math-utils.lsp 10.91 KB
一键复制 编辑 原始数据 按行查看 历史
;数学类基本函数
;;;name:BF-math-union
;;;desc:列表并集
;;;arg:lst1:列表
;;;arg:lst2:列表
;;;return:并集运算后的列表
;;;example:(BF-math-union '(102.946 68.6354 3) '(112.102 97.4851 3))
(defun BF-math-union (lst1 lst2)
(append lst1
(vl-remove-if '(lambda (x) (member x lst1)) lst2)
)
)
;;;函数名称:BF-Math-SymmetricDifference
;;;函数说明:列表对称差集--leemac
;;;参 数:l1:列表
;;;参 数:l2:列表
;;;返 回 值:对称差集运算后的列表
;;;示 例:(BF-Math-SymmetricDifference l1 l2)
(defun BF-Math-SymmetricDifference ( l1 l2 )
(append
(vl-remove-if '(lambda ( x ) (member x l2)) l1)
(vl-remove-if '(lambda ( x ) (member x l1)) l2)
)
)
;;;name:BF-math-Difference
;;;desc:列表差集
;;;arg:lst1:列表
;;;arg:lst2:列表
;;;return:差集运算后的列表
;;;example:(BF-math-Difference '(102.946 68.6354 3) '(112.102 97.4851 3))
(defun BF-math-Difference (lst1 lst2 / lst)
(vl-remove-if '(lambda ( x ) (member x lst2)) lst1)
)
;;;name:BF-math-intersect
;;;desc:列表交集
;;;arg:lst1:列表
;;;arg:lst2:列表
;;;return:交集运算后的列表
;;;example:(BF-math-intersect '(102.946 68.6354 3) '(112.102 97.4851 3))
(defun BF-math-intersect (lst1 lst2)
(vl-remove-if-not '(lambda (x) (member x lst2)) lst1)
)
;;;name:BF-math-minlist
;;;desc:计算列表的最小值
;;;arg:lst:列表
;;;return:列表的最小值
;;;example:(BF-math-minlist '(102.946 68.6354 3))
(defun BF-math-minlist (lst)
(if (atom lst)
lst
(apply 'min lst))
)
;;;name:BF-math-maxlist
;;;desc:计算列表的最大值
;;;arg:lst:列表
;;;return:列表的最大值
;;;example:(BF-math-maxlist '(102.946 68.6354 3))
(defun BF-math-maxlist (lst)
(if (atom lst)
lst
(apply 'max lst))
)
;;;name:BF-math-power
;;;desc:增强power函数,目的为扩展expt函数
;;;arg:base:字符串,数字,列表类型,其他类型返回nil
;;;arg:pow:整数(用于字符串,列表,数字)实数(用于数字)
;;;return:参数都为数字时,返回expt计算的结果,base为字符串和列表时,返回自乘的结果
;;;example:(BF-math-power '(102.946 68.6354 3) 2)
(defun BF-math-power (base pow / str1)
(cond
((BF-stringp base)
(progn
(setq str1 "")
(repeat pow
(setq str1 (strcat str1 base))
)
))
((or (BF-intp base)(BF-realp base)) (expt base pow))
((listp base)
(progn
(repeat pow
(setq str1 (cons base str1))
)
))
(t nil)
)
)
;;;name:BF-math-degress->radions
;;;desc:角度转弧度函数
;;;arg:degress:角度值,十进制
;;;return:弧度
;;;example:(BF-math-degress->radions 45)
(defun BF-math-degress->radions (degress)
(if (numberp degress)
(* pi (/ degress 180.0))
)
)
;;;name:BF-math-radions->degress
;;;desc:弧度转角度函数
;;;arg:degress:弧度值
;;;return:角度
;;;example:(BF-math-radions->degress 1.2)
(defun BF-math-radions->degress (radions)
(if (numberp radions)
(* radions (/ 180.0 pi))
)
)
;;;name:BF-math-dms
;;;desc:根据给定十进制角度返回度分秒格式的表
;;;arg:degress:角度值,十进制
;;;return:度分秒表,数字格式
;;;example:(BF-math-dms 1.2)
(defun BF-math-dms (degress / d x m s)
(setq d (fix degress))
(setq x (* (- degress d) 60))
(setq m (fix x))
(setq s (* (- x m) 60))
(list d m s)
)
;;;name:BF-math-dmm
;;;desc:根据给定弧度返回度分秒格式的表
;;;arg:degress:弧度值
;;;return:度分秒表,字符串格式
;;;example:(BF-math-dmm 1.2)
(defun BF-math-dmm (ang)
(vl-remove-if '(lambda (x) (= "" x)) (BF-Str-ParseByLst (angtos ang 1 4) '("d" "'" "\"")))
)
;;Tangent - Lee Mac
;;;name:BF-math-tan
;;;desc:计算正切值
;;;arg:x:弧度值
;;;return:正切值
;;;example:(BF-math-tan 1.2)
(defun BF-math-tan (x)
(if (not (equal 0.0 (cos x) 1e-10))
(/ (sin x) (cos x))
)
)
;;;函数名称:BF-Math-Length
;;;函数说明:两点长度(距离),等同于两点向量的模
;;;参 数:start:第一点坐标
;;;参 数:end:第二点坐标
;;;返 回 值:长度
;;;示 例:(BF-Math-Length start end)
(defun BF-Math-Length (start end)
(BF-Vec-Norm (mapcar '- end start))
)
;;;name:BF-math-mid
;;;desc:计算中点
;;;arg:x:第一点坐标
;;;arg:y:第二点坐标
;;;return:中点坐标
;;;example:(BF-math-mid '(1 2 0) '(2 3 0))
(defun BF-math-mid (x y / a b)
(mapcar '(lambda (a b) (* (+ a b) 0.5)) x y)
)
;; 反正弦 - Lee Mac
;;;name:BF-math-asin
;;;desc:计算反正弦值
;;;arg:x:数值,-1 <= x <= 1
;;;return:弧度值
;;;example:(BF-math-asin 0.8)
(defun BF-math-asin (x)
(if (<= -1.0 x 1.0)
(atan x (sqrt (- 1.0 (* x x))))
)
)
;; 反余弦 - Lee Mac
;;;name:BF-math-acos
;;;desc:计算反余弦值
;;;arg:x:数值,-1 <= x <= 1
;;;return:弧度值
;;;example:(BF-math-acos 0.8)
(defun BF-math-acos (x)
(if (<= -1.0 x 1.0)
(atan (sqrt (- 1.0 (* x x))) x)
)
)
;; 双曲正弦 - Lee Mac
;;;name:BF-math-sinh
;;;desc:计算双曲正弦值
;;;arg:x:数值
;;;return:双曲正弦值
;;;example:(BF-math-sinh 0.8)
(defun BF-math-sinh (x)
(/ (- (exp x) (exp (- x))) 2.0)
)
;; 双曲余弦 - Lee Mac
;;;name:BF-math-cosh
;;;desc:计算双曲余弦值
;;;arg:x:数值
;;;return:双曲余弦值
;;;example:(BF-math-cosh 0.8)
(defun BF-math-cosh (x)
(/ (+ (exp x) (exp (- x))) 2.0)
)
;; 双曲正切 - Lee Mac
;;;name:BF-math-tanh
;;;desc:计算双曲正切值
;;;arg:x:数值
;;;return:双曲正切值
;;;example:(BF-math-tanh 0.8)
(defun BF-math-tanh (x)
(/ (BF-math-sinh x) (BF-math-cosh x))
)
;; Area Hyperbolic Sine - Lee Mac
;;;name:BF-math-arsinh
;;;desc:计算反双曲正弦值
;;;arg:x:数值
;;;return:反双曲正弦值
;;;example:(BF-math-arsinh 0.8)
(defun BF-math-arsinh (x)
(log (+ x (sqrt (1+ (* x x)))))
)
;; Area Hyperbolic Cosine - Lee Mac
;;;name:BF-math-arcosh
;;;desc:计算反双曲余弦值
;;;arg:x:数值,1 <= x
;;;return:反双曲余弦值
;;;example:(BF-math-arcosh 1.8)
(defun BF-math-arcosh (x)
(if (<= 1.0 x)
(log (+ x (sqrt (1- (* x x)))))
)
)
;; Area Hyperbolic Tangent - Lee Mac
;;;name:BF-math-artanh
;;;desc:计算反双曲正切值
;;;arg:x:数值,-1 < x < 1
;;;return:反双曲正切值
;;;example:(BF-math-artanh 1.8)
(defun BF-math-artanh ( x )
(if (< (abs x) 1.0)
(/ (log (/ (1+ x) (- 1.0 x))) 2.0)
)
)
;;;name:BF-math-trim
;;;desc:数值后续零清除
;;;arg:RealNum:实数
;;;return:清除后续零的实数
;;;example:(BF-math-trim 1.8000)
(defun BF-math-trim (RealNum / dimzin1 result)
(setq DimZin1 (getvar "DIMZIN"))
(setvar "DIMZIN" 8)
(setq result (vl-catch-all-apply 'rtos (list RealNum 2 8)))
(setvar "DIMZIN" DimZin1)
(if (not (vl-catch-all-error-p result))
result
)
)
;;;name:BF-math-rtos
;;;desc:保留小数位数(四舍五入)
;;;arg:Real:实数
;;;arg:prec:保留位数
;;;return:四舍五入后的字符串
;;;example:(BF-math-rtos 1.8000 3)
(defun BF-math-rtos (real prec / dimzin result)
(setq dimzin (getvar 'dimzin))
(setvar 'dimzin 0)
(setq result (vl-catch-all-apply 'rtos (list real 2 prec)))
(setvar 'dimzin dimzin)
(if (not (vl-catch-all-error-p result))
result
)
)
;;;name:BF-math-cal
;;;desc:根据给定表达式计算结果
;;;arg:lst1:表达式变量表
;;;arg:lst2:表达式给定变量值
;;;arg:str:表达式字符串
;;;return:表达式计算的结果
;;;example:(BF-math-cal '(a b c) '(1 2 3) "a+b+c")
(defun BF-math-cal (lst1 lst2 str)
(if (not (BF-list-exist (arx) "geomcal.arx"))(arxload "geomcal" "\n加载geomcal失败!"))
(mapcar 'set lst1 lst2)
(if (vl-every '(lambda (x) (= 'real (type x))) lst2)
(cal (strcat "1.0*(" str ")"))
(cal str)
)
)
;;;计算某个角度(以x轴正向,逆时针)的方位角(以Y轴正向,顺时针)
;;;name:BF-math-azimuth
;;;desc:计算某个角度(以x轴正向,逆时针)的方位角(以Y轴正向,顺时针)
;;;arg:ang:弧度
;;;return:表示方位角的弧度
;;;example:(BF-math-azimuth 1.8)
(defun BF-math-azimuth (ang)
(cond
((= ang 0) (setq ang (* 0.5 pi))) ;x+
((= ang (* 0.5 pi)) (setq ang 0)) ;y+
((= ang pi) (setq ang (* 1.5 pi))) ;x-
((= ang (* 1.5 pi)) (setq ang pi)) ;y-
((= ang (* 2 pi)) (setq ang 0)) ;x+
((and (< ang (* 0.5 pi)) (> ang 0)) ;1
(setq ang (- (* 0.5 pi) ang))
)
;() ;2 180-x+180+90 2.5pi-x
;() ;3 1.5pi-x+pi
(t (setq ang (- (* 2.5 pi) ang)))
)
)
;;;函数名称:BF-math-TransPt
;;;函数说明:根据已知世界坐标和用户坐标的基准点,计算世界坐标对应的用户坐标
;;;参 数:base:已知世界坐标基准点
;;;参 数:usrpt:已知用户坐标基准点
;;;参 数:transpt:待计算世界坐标
;;;参 数:ang:用户坐标系逆时针旋转角度的弧度值
;;;返 回 值:用户坐标
;;;示 例:(BF-math-TransPt base usrpt transpt ang)
(defun BF-math-TransPt (base usrpt transpt ang)
(car (BF-Mat-RotateByMatrix
(BF-Mat-TranslateByMatrix (list transpt) base usrpt)
usrpt (- ang)))
)
;;;name:BF-math-calheight
;;;desc:根据坡度、pt1、pt2,计算新的pt2
;;;arg:pt1:基准点
;;;arg:pt2:目标点
;;;arg:podu:坡度
;;;return:目标点的高程
;;;example:(BF-math-calheight pt1 pt2 0.1)
(defun BF-math-calheight (pt1 pt2 podu)
(subst
(+ (caddr pt1)
(* podu (distance
(BF-point-3d->2d pt1)
(BF-point-3d->2d pt2)
)
)
)
(caddr pt2)
pt2
)
)
;;;name:BF-Math-Rand
;;;desc:计算随机数,leemac
;;;arg:
;;;return:0-1之间的随机数
;;;example:(BF-Math-Rand)
(defun BF-Math-Rand (/ a c m)
(setq m 4294967296.0
a 1664525.0
c 1013904223.0
$xn (rem (+ c
(* a
(cond ($xn)
((getvar 'date))
)
)
)
m
)
)
(/ $xn m)
)
;;;name:BF-Math-RandRange
;;;desc:计算给定范围内的随机数,leemac
;;;arg:a:范围下限
;;;arg:b:范围上限
;;;return:定范围内的随机整数
;;;example:(BF-Math-RandRange 2 10)
(defun BF-Math-RandRange ( a b )
(+ (min a b) (fix (* (BF-Math-Rand) (1+ (abs (- a b))))))
)
;;;name:BF-Math-dec->base
;;;desc:十进制转为指定进制数,leemac
;;;arg:n:十进制
;;;arg:b:指定进制
;;;return:十进制数在指定进制的字符串表达
;;;example:(BF-Math-dec->base 10 2) ===>"1010"
(defun BF-Math-dec->base ( n b )
(if (< n b)
(chr (+ n (if (< n 10) 48 55)))
(strcat (BF-Math-dec->base (/ n b) b) (BF-Math-dec->base (rem n b) b))
)
)
;;;name:BF-Math-base->dec
;;;desc:指定进制数转为十进制,leemac
;;;arg:n:指定进制数字字符串
;;;arg:b:指定进制
;;;return:十进制数
;;;example:(BF-Math-base->dec "1010" 2) ===>10
(defun BF-Math-base->dec ( n b / l )
(if (= 1 (setq l (strlen n)))
(- (ascii n) (if (< (ascii n) 65) 48 55))
(+ (* b (BF-Math-base->dec (substr n 1 (1- l)) b)) (BF-Math-base->dec (substr n l) b))
)
)
;;;name:BF-Math-base->base
;;;desc:指定进制数转换,leemac
;;;arg:n:指定进制数字字符串
;;;arg:b1:指定进制
;;;arg:b2:要转换的进制
;;;return:表示转换后的数字字符串
;;;example:(BF-Math-base->base "1010" 2 16) ===>"A"
(defun BF-Math-base->base ( n b1 b2 )
(BF-Math-dec->base (BF-Math-base->dec n b1) b2)
)
;;;函数名称:BF-Math-SortByCurve
;;;函数说明:沿曲线排序
;;;参 数:curve:曲线对象
;;;参 数:lst:排序的点表
;;;返 回 值:排序后的点表
;;;示 例:(BF-Math-SortByCurve curve lst)
(defun BF-Math-SortByCurve (curve lst)
(vl-sort
lst
(function
(lambda (p1 p2 / m n)
(setq m (vlax-curve-getClosestPointTo curve p1 t))
(setq n (vlax-curve-getClosestPointTo curve p2 t))
(cond
((< (vlax-curve-getDistAtPoint curve m) (vlax-curve-getDistAtPoint curve n)))
((equal m n 1e-8)
(< (distance p1 m) (distance p2 n))
)
)
)
)
)
)
马建仓 AI 助手
尝试更多
代码解读
代码找茬
代码优化
Lisp
1
https://gitee.com/nirs_674971560/abfl.git
git@gitee.com:nirs_674971560/abfl.git
nirs_674971560
abfl
AutoLispBaseFunctionLibrary
master

搜索帮助