[活动结束]LISP知识问答第2期--基础篇2-(难度指数:★)
本帖最后由 caoyin 于 2011-1-6 23:53 编辑LISP知识问答比赛第二期——基础篇2
将来会开源
为新手提供一个提高的机会
[参赛时间]2010年12月25日~2011年01月05日
[参赛资格]明经会员
[评审]由明经通道论坛组织评审，并给予文字点评。
[要求]
1.运行结果错误不得分。
2.答案具有通用性。程序能够在不加载任何第三方插件的情况下在AutoCAD2004~2011官方标准安装版上测试通过。
3.以写函数的方式答题，答案必须为源代码且愿意公开。
4. 代码要求及打分比例
算法好，执行快 (50%)
思路新颖、特别 (30%)
代码精简 (20%)
[奖励]根据情况由论坛商定酌情加分，高手为你解答疑问。
[参赛办法]参赛者直接贴出源码、相同或理论相同的代码以先答者为准。
1.选择集转为图元表
格式：(ss->ents ss)
返回选择集ss中的图元组成的表．
2.图元表转为选择集
格式：(ents->ss ents ss)
如果选择集ss/=nil将ents表中的图元加入到ss中,并返回ss
如果 ss=nil,新建一个选择集并返回．
3.设置图元的一个组码值
格式：(setdxf ent vallst)
ent：图元
vallst：可以是单表或复表，可以是表也可以是点对组成的表
4.做一个新图层
格式：(maklayer name color lt lw)
name:string 图层名
color：int 颜色号
lt：string 线型名
lw:线宽值
说明：当color lt lw为nil时取默认值
线型没加载时自动acadiso.acad 两个文件中加载．
成功后返回新图层对象失败返回nil．
5.返回指定图元后的所有图元组成的表
格式：(EntNextAll ent)
ent：指定的标志图元
返回：图元之后生成的所有图元组成的表．
特别：当ent为nil时返回图中所有的图元组成的表
6.按指定长度，分割一个表，成多个小表
格式:(ListSplit1 lst len)
lst：要分割的表
len：int 子表长度
比如：(ListSplit1 '(0 1 2 3 4 5 6 7 8 9) 3)
返回 '((0 1 2) (3 4 5) (6 7 8) (9))
7.按指定长度，依次分割一个表，成多个小表
格式:(ListSplit2 lst len)
lst：要分割的表
len：int 子表长度
比如：(ListSplit2 '(0 1 2 3 4 5 6 7 8 9) 3)
返回 '((0 1 2)(1 2 3) (2 3 4)(3 4 5) (4 5 6) (5 6 7)(6 7 8)(7 8 9))
8.表内公约数
格式:(listgcd lst)
lst:表
比如：(listgcd '(2 4 6 8))
返回2
9.两个表(第一个元素为字符串)合并相同字符串
格式:(listhb lst1 lst2)
lst1 lst2:表
比如：'(("A" 15) ("B" 25) ("1" 36) ("C" 78))
'(("A" 0.5 6.2) ("B" 5.2) ("1" 4.25) ("2" 6.5)))
返回'(("A" 15 6.2 0.5) ("B" 25 5.2) ("1" 36 4.25) ("C" 78 0) ("2" 6.5 0))
10.数字字符或者实数整数四舍五入返回字符串
格式:(4-5 a n)
a:为数字字符 "4.2" 实数 5.6 整数7
n:为保留的小数个数
比如:(4-5 "4.2" 3)
返回"4.200" 谢谢分享，学习了~ 第2题， ss!=nil还是写成 ss/=nil 看起来舒服些
第3题
.设置图元的一个组码值
格式：(setdxf ent dxf value)
建议改为 格式：(setdxf ent vallst)
vallst 可以是单表或复表，可以是表也可以是点对组成的表
第10题，函数名 4-5 容易看混淆，不如用sswr（四舍五入第一个拼音字母）
狂刀lxx 发表于 2010-12-25 02:53 static/image/common/back.gif
第2题， ss!=nil还是写成 ss/=nil 看起来舒服些
第3题
.设置图元的一个组码值
根据刀的意见已改 本帖最后由 redcat 于 2010-12-28 23:11 编辑
-----------------------------------------------------------------------------
点评：
红色部分为LONGFIN 点评，仅仅作为一种参考意见，目的在于使
答题者和大家形成良好的学习氛围。谬误之处请大家指正！
-----------------------------------------------------------------------------
没啥难度http://user.qzone.qq.com/94671228/
1.
;;;功能:选择集转化为图元表或vla对象表
;;;参数:1.sset→选择集
;;; 2.xflag→转换标记
;;;返回值:当xflag为nil时转化为图元表，否则转化为vla对象表
;;;示例： (sset->list (ssget) nil)
(defun sset->list (sset xflag / ssetlist)
(setq ssetlist
(vl-remove-if
'listp
(mapcar 'cadr (ssnamex sset))
) ;_ 结束vl-remove-if
) ;_ 结束setq
(if xflag
(mapcar 'vlax-ename->vla-object ssetlist);转化为vla对象表
ssetlist
) ;_ 结束if
) ;_ 结束defun
-------------------------------------------------------------------------------------
1.值得肯定的是答题者对LISP基础知识理解很透彻，ssnamex的使用不失为一种新意。
2.缺点是本函数采用了3次遍历，代码虽简洁，但进行的计算并不一定简洁。可以改为
两次或者一次遍历（因为程序本身简单、可能感觉不到能节省多少时间，但对于复杂程
序，则能看出有所不同。）
3.返回值可能有所偏差，即xflag假如为nil，而无法返回ssetlist了。
-------------------------------------------------------------------------------------
;;;===========================
;;;功能:选择集转化为vla对象数组
;;;参数:1.sset→选择集
;;;返回值:vla对象数组
;;;示例： (sset->array(ssget))
(defun sset->array (sset / ssetlist)
(setq ssetlist (sset->list sset t))
(vlax-safearray-fill
(vlax-make-safearray vlax-vbObject (cons 0 (1- (length ssetlist))))
ssetlist
) ;_ 结束vlax-safearray-fill
) ;_ 结束defun
;;;================================
;;;功能:选择集转化为vla对象变体数组
;;;参数:1.sset →选择集
;;;返回值:vla对象变体数组
;;;示例： (sset->variant (ssget))
(defun sset->variant (sset / objlist)
(setq objlist (sset->list sset t))
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbObject (cons 0 (1- (length objlist))))
objlist
) ;_ 结束vlax-safearray-fill
) ;_ 结束vlax-make-variant
) ;_ 结束defun
本帖最后由 redcat 于 2010-12-28 15:34 编辑
2.
;(ents->ss (sset->list (ssget) nil) nil)
(defun ents->ss (ents ss / ename)
(if (= ss nil)
(setq ss (ssadd))
) ;_ 结束if
(mapcar '(lambda (ename) (setq ss (ssadd ename ss))) ents)
;或者将上一句改为(foreach ename ents(setq ss (ssadd ename ss)))
ss
) ;_ 结束defun 这次活动贼人又可以偷不少 哈哈 我知道贼人是谁 不老实就ko他！
为大家提供一个好的平台！ 回复 redcat 的帖子
测试过了，速度还可以要比repeat快
2.如果转化为图元表循环只有2次，vla对象表(是为vla开发准备的)为3次。
3.返回值可能有所偏差，即xflag假如为nil，而无法返回ssetlist了。
这个可以返回如有不行，请版主给个实例
如果只转化为图元表，只要下面就足以
(defun ss-lst(sset)
(vl-remove-if
'listp
(mapcar 'cadr (ssnamex sset))
) ;_ 结束vl-remove-if
)
回复 redcat 的帖子
(if xflag
(mapcar 'vlax-ename->vla-object ssetlist);转化为vla对象表
ssetlist) ;_
蓝色部分上次可能没有或者我没看到。
------------------------------------------------------------------------------
;;如下两种方法仅为理论推理，运行速度未经测试。
(defun sset->list (sset xflag / lst)
(foreach x (ssnamex sset)
(if (not (listp (setq x (cadr x))))
(if xflag
(setq lst (cons (vlax-ename->vla-object x) lst))
(setq lst (cons x lst))
)
)
)
lst
)
(defun sset->list (sset xflag / lst)
(foreach x (ssnamex sset)
(if (not (listp (setq x (cadr x))))
(setq lst (cons x lst))
)
)
(if xflag
(mapcar 'vlax-ename->vla-object lst)
lst
)
)
;;经过露水的测试if xflag 放在循环里面慢的很多