马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
![](source/plugin/imc_colorcode/images/loading.gif) - ;; (xl-remove)(xl-eq)(xl-mem)(xl-rem)(xl-rems)
- ;| (xl-remove rlst lst fz) = 排除表中重复项及属于排除列表中的项,支持精度--------梁雄啸.2004.4
- 参数: rlst为要排除的列表.fz=精度.
- 关联: (xl-pts1 pts fuzz) = 点表去除重复点;(本函数更通用!)
- 例: (交点表处理-过滤重复点和与曲线首尾相同的点.返回新的点表.)
- (setq rlst (list (vlax-curve-getstartpoint curobj) (vlax-curve-getendpoint curobj)))
- (setq nlst (xl-remove rlst lst 0.01)) ;lst为已经求得的点表.
- |;
- (defun xl-remove ( rlst lst fz / nlst)
- (mapcar '(lambda (x)
- (if (not(or (xl-mem x nlst fz) (xl-mem x rlst fz)));; xl-mem
- (setq nlst (append nlst (list x)))
- )) lst)
- )
- ;|比较两个表lst1 ,lst2 是否相等,支持精度. 效果同equal.
- 例: (xl-eq '(3.01 2.9 2) '(3.02 2.82 2) 0.1) -> T;
- (xl-eq '(3.01 2.9 2) '(3.02 2.82 2) 0.01) -> nil.
- |;
- (defun xl-eq (lst1 lst2 fz / i)
- (equal lst1 lst2 fz)
- )
- ;|判断点元素是否在点表内.支持精度
- 例: (xl-mem '(3.01 2.9 2) '((3.01 2.82 2) (1 1 2)(3 2.01 0)) 0.1) -> T
- (xl-mem '(3.01 2.9 2) '((3.01 2.82 2) (1 1 2)(3 2.01 0)) 0.01) -> nil
- (equal "a" "a" 1);->T
- (equal '(0.1 "a") '(0.2 "a") 1);->T
- (equal '(0.1 "a") '(0.2 "a") 0.01);->nil
- |;
- (defun xl-mem (lst xlst fz / )
- (apply 'or (mapcar '(lambda (x) (equal x lst fz)) xlst))
- )
- ;;/////////////////////////////////////////////////////////////////;;
- ;;------------------------简单函数---------------------------------;;
- ;| (xl-rem at lst ) = 表剔除元素;-------------lxx.2004.1
- ;提示; 用mapcar每元素做list,用append 对nil忽略的特性.
- !!!等同于: (vl-remove element-to-remove list)
- (xl-rem "a" '(58 3 (a . 8) "a" 4.5)) -> (58 3 (A . 8) 4.5)
- |;
- (defun xl-rem (at lst) ;at=atom
- (apply 'append (subst nil (list at) (mapcar 'list lst)))
- )
- ;| (xl-rems atlst lst ) = 表剔除多个元素;-------------lxx.2004.1
- ;提示; 用mapcar每元素做list,用append 对nil忽略的特性.
- (xl-rems '("a" 58) '(58 3 (a . 8) "a" 4.5)) -> (3 (A . 8) 4.5)
- |;
- (defun xl-rems (atlst lst) ;at=atom
- (foreach n atlst (setq lst (apply 'append (subst nil (list n) (mapcar 'list lst)))))
- )
|