[活动结束]LISP知识问答第2期--基础篇2-(难度指数:★)

露水2

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"

yssok

谢谢分享，学习了~

狂刀lxx

第2题， ss!=nil  还是写成 ss/=nil 看起来舒服些
第3题
.设置图元的一个组码值
  格式：(setdxf ent dxf value)
建议改为 格式：(setdxf ent vallst)
vallst 可以是单表或复表，可以是表也可以是点对组成的表
第10题，函数名 4-5 容易看混淆，不如用sswr（四舍五入第一个拼音字母）

露水2

狂刀lxx 发表于 2010-12-25 02:53
第2题， ss!=nil  还是写成 ss/=nil 看起来舒服些
第3题
.设置图元的一个组码值

根据刀的意见已改

redcat

-----------------------------------------------------------------------------
点评：
红色部分为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

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

redcat

这次活动贼人又可以偷不少

露水2

哈哈 我知道贼人是谁 不老实就ko他！
  为大家提供一个好的平台！

redcat

回复 redcat 的帖子

测试过了，速度还可以要比repeat快
2.如果转化为图元表循环只有2次，vla对象表(是为vla开发准备的)为3次。
3.返回值可能有所偏差，即xflag假如为nil，而无法返回ssetlist了。
这个可以返回如有不行，请版主给个实例
如果只转化为图元表，只要下面就足以

2. (defun ss-lst(sset)   
   
3. (vl-remove-if
   
4.               'listp
   
5.              (mapcar 'cadr (ssnamex sset))
   
6.        ) ;_ 结束vl-remove-if
   
7. )
   

(defun ss-lst(sset)    <br /> (vl-remove-if<br />               'listp<br />              (mapcar 'cadr (ssnamex sset))<br />        ) ;_ 结束vl-remove-if<br /> )<br />

caoyin

回复 redcat 的帖子


(if xflag
        (mapcar 'vlax-ename->vla-object ssetlist);转化为vla对象表
         ssetlist) ;_

蓝色部分上次可能没有或者我没看到。

------------------------------------------------------------------------------

1. ;;如下两种方法仅为理论推理，运行速度未经测试。
   
2. (defun sset->list (sset xflag / lst)
   
3.    (foreach x (ssnamex sset)
   
4.       (if (not (listp (setq x (cadr x))))
   
5.          (if xflag
   
6.             (setq lst (cons (vlax-ename->vla-object x) lst))
   
7.             (setq lst (cons x lst))
   
8.          )
   
9.       )
   
10.    )
    
11.   lst
    
12. )
    
13. (defun sset->list (sset xflag / lst)
    
14.    (foreach x (ssnamex sset)
    
15.       (if (not (listp (setq x (cadr x))))
    
16.             (setq lst (cons x lst))
    
17.       )
    
18.    )
    
19.   (if xflag
    
20.     (mapcar 'vlax-ename->vla-object lst)
    
21.     lst
    
22.   )
    
23. )

;;如下两种方法仅为理论推理，运行速度未经测试。<br /> (defun sset->list (sset xflag / lst)<br />    (foreach x (ssnamex sset)<br />       (if (not (listp (setq x (cadr x))))<br />          (if xflag<br />             (setq lst (cons (vlax-ename->vla-object x) lst))<br />             (setq lst (cons x lst))<br />          )<br />       )<br />    )<br />   lst<br /> )<br /> (defun sset->list (sset xflag / lst)<br />    (foreach x (ssnamex sset)<br />       (if (not (listp (setq x (cadr x))))<br />             (setq lst (cons x lst))<br />       )<br />    )<br />   (if xflag<br />     (mapcar 'vlax-ename->vla-object lst)<br />     lst<br />   )<br /> )

;;经过露水的测试  if xflag 放在循环里面慢的很多