[讨论]：提取符号的符号名

秋枫 · 发表于 2002-9-15 18:08:31

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

symtostr = vl-sybmol-name

大家讨论一下这段代码的实现机制如何？

[FONT=courier new]
(defun SymToStr (SymbolName)
;; If the argument is a symbol ...
(if (= (type SymbolName) 'SYM)
(progn ;; Execute the function we are going to create ...
(;; Create a function on the fly
(list ;; The argument and local variable list. Note
;; that SymbolName will be evaluated, so the
;; symbol name that we're trying to convert
;; will be a local variable.
(list '/ SymbolName)
;; Set the local variable to 0 to make sure it
;; appears in the atoms-family (variables that
;; are "bound to NIL", explicitly or implicitly,
;; do not appear in the atoms-family)
(list set (quote SymbolName) 0)
;; In "native "AutoLISP", the symbol would
;; now be the first one in the atoms-family
;; list. Not so in Visual LISP. So we have
;; to look up the symbol [as a symbol] using
;; (member ...), compute its position in the
;; list, and then extract it from the string
;; version of the atoms-family list. This
;; also sets up the return value.
(list nth
(list -
(list length (list atoms-family 0))
(list length
(list member
(list (quote quote) SymbolName)
(list atoms-family 0)
) ;_ end list
) ;_ end list
) ;_ end list
(list atoms-family 1)
) ;_ end list
;; End of the dynamic function
) ;_ end list
)
) ;_ end progn
;; If the argument is not a symbol, return NIL
nil
) ;_ end if
) ;_ end defun
[/FONT]

[FONT=courier new] 
(defun SymToStr        (SymbolName) 
  ;; If the argument is a symbol ... 
  (if (= (type SymbolName) 'SYM) 
    (progn ;; Execute the function we are going to create ... 
           (;; Create a function on the fly 
            (list ;; The argument and local variable list.  Note 
                  ;; that SymbolName will be evaluated, so the 
                  ;; symbol name that we're trying to convert 
                  ;; will be a local variable. 
                  (list '/ SymbolName) 
                  ;; Set the local variable to 0 to make sure it 
                  ;; appears in the atoms-family (variables that 
                  ;; are "bound to NIL", explicitly or implicitly, 
                  ;; do not appear in the atoms-family) 
                  (list set (quote SymbolName) 0) 
                  ;; In "native "AutoLISP", the symbol would 
                  ;; now be the first one in the atoms-family 
                  ;; list.  Not so in Visual LISP.  So we have 
                  ;; to look up the symbol [as a symbol] using 
                  ;; (member ...), compute its position in the 
                  ;; list, and then extract it from the string 
                  ;; version of the atoms-family list.  This 
                  ;; also sets up the return value. 
                  (list        nth 
                        (list - 
                              (list length (list atoms-family 0)) 
                              (list length 
                                    (list member 
                                          (list (quote quote) SymbolName) 
                                          (list atoms-family 0) 
                                    ) ;_ end list 
                              ) ;_ end list 
                        ) ;_ end list 
                        (list atoms-family 1) 
                  ) ;_ end list 
                  ;; End of the dynamic function 
            ) ;_ end list 
           ) 
    ) ;_ end progn 
    ;; If the argument is not a symbol, return NIL 
    nil 
  ) ;_ end if 
) ;_ end defun 
 
[/FONT]

秋枫 · 发表于 2002-9-15 18:29:20

去掉注释

[FONT=courier new]
(defun SymToStr (SymbolName)
(if (= (type SymbolName) 'SYM)
(progn ((list (list '/ SymbolName)
(list set (quote SymbolName) 0)
(list nth
(list -
(list length (list atoms-family 0))
(list length
(list member
(list (quote quote) SymbolName)
(list atoms-family 0)
)
)
)
(list atoms-family 1)
)
)
)
)
nil
)
)
[/FONT]

XDSoft · 发表于 2002-9-15 18:49:11

利用了：atoms-family

[FONT=courier new]
返回由当前已定义的符号组成的一个表
(atoms-family format [symlist])
参数
format
值为 0 或 1 的整数，它用于指定 atoms-family 函数返回符号名的格式：
0 以表的形式返回符号名
1 以字符串表的形式返回符号名
symlist
用于指定用户想搜索的符号名的字符串表。
返回值
符号表。如果指定了 symlist，atoms-family 返回当前定义的指定符号，对那些没有定义的符号返回 nil。
样例
命令：(atoms-family 0)
(BNS_PRE_SEL FITSTR2LEN C:AI_SPHERE ALERT DEFUN C:BEXTEND REM_GROUP
B_RESTORE_SYSVARS BNS_CMD_EXIT LISPED FNSPLITL...
下列代码检验符号 CAR、CDR 和 XYZ 是否已被定义并将其以字符串表形式返回：
命令：(atoms-family 1 '("CAR" "CDR" "XYZ"))
("CAR" "CDR" nil)
这个返回的字符串表表明符号 XYZ 没有被定义。[/FONT]

复制代码

显示全部楼层 · 发表于 2002-9-15 19:02:17

提示: 作者被禁止或删除内容自动屏蔽

秋枫 · 发表于 2002-9-15 23:19:36

我的理解，
这种方法与lambda等价，

[FONT=courier new]
;;; 下面等价：
((list '(a b)
'(princ "\n******\n")
'(princ (+ a b))
'(princ "\n******\n")
'(princ))
1
2
)
((lambda (a b)
(princ "\n******\n")
(princ (+ a b))
(princ "\n******\n")
(princ)
)
1
2
)[/FONT]

复制代码

XDSoft · 发表于 2002-9-15 23:22:12

MSN讨论：

秋枫说：
你能不能完整理解这个函数？
秋枫说：
我有点困难。
XDSoft 说：
我看看
秋枫说：
我不是指他的算法
秋枫说：
指程序的结构。
XDSoft 说：
哦
秋枫说：
他的算法很简单，利用 atomfamily　0得到符号的位置，再利用atomfamily 1得到字符串版本。
秋枫说：
Create a function on the fly
秋枫说：
从这里开始，我不大看得懂结构了。
秋枫说：
看上去象是创建一段临时函数
秋枫说：
但又不用lambda
XDSoft 说：
构造表
XDSoft 说：
让LISP求值
秋枫说：
(list '/ SymbolName)
这里是定义局部变量
秋枫说：
我无法重现
XDSoft 说：
命令: (list '/ 'abc)
(/ ABC)
秋枫说：
'（1　2　3　。。。）与(list 1 2 3 ...)是不是等价的？
XDSoft 说：
应该
秋枫说：
(progn (setq abc 'TESTSYM)
   ((list (list '/ abc) (list set 'abc 1) (list princ abc)))
   (princ abc)
)

秋枫说：
(progn (setq abc 'TESTSYM)
   ( '( '('/ abc) '(set 'abc 1) '(princ abc)))
   (princ abc)
)
秋枫说：
这两段，
秋枫说：
如果是等价的，
秋枫说：
那么结果应该相同。
XDSoft 说：
你试试
秋枫说：
当然试了，不同。
秋枫说：
秋枫说：
当然，有了vl后，这个函数与 vl-symbol-name 的功能相同。
秋枫说：
但，他的纯autolisp的方法，太费解了。
XDSoft 说：
哦
秋枫说：
_$ (princ (list 'a 'b (list 'c)))
(A B  )(A B  )
_$ (princ '('a 'b '('c)))
((QUOTE A) (QUOTE B) (QUOTE ((QUOTE C))))((QUOTE A) (QUOTE B) (QUOTE ((QUOTE C))))
XDSoft 说：
如何？
秋枫说：
不同。
XDSoft 说：
他的原理还是构筑表，然后让LISP求值
秋枫说：
((list '(a b)
   '(princ "\n******\n")
   '(princ (+ a b))
   '(princ "\n******\n")
   '(princ))
  1
  2
)

((lambda (a b)
(princ "\n******\n")
(princ (+ a b))
(princ "\n******\n")
(princ)
)
  1
  2
)
秋枫说：
这两个完全等价
秋枫说：
lambda函数，完全是多余的
XDSoft 说：
求值

  已将高山流水-夜雨风轻添加到对话中。

秋枫说：
它这个symtostr，构思很妙，
高山流水-夜雨风轻说：

秋枫说：
是不是不用这种方法（用list定义一个函数）
秋枫说：
就无法求出symbol的名称字串？
高山流水-夜雨风轻说：
bb，我要休息了
秋枫说：
bb
秋枫说：
(defun Sym->Str (sym / tmp symname)
  (setq tmp (eval sym))
  (setq symname (nth (- (length (atoms-family 0))
(length (member sym (atoms-family 0)))
      )
      (atoms-family 1)
)
  )
  (set sym tmp)
  symname
)
秋枫说：
嗯，我写了一个
秋枫说：
这个也可以用。
秋枫说：
$ (sym->str 'abc)
"ABC"
XDSoft 说：
好
XDSoft 说：
贴到那个帖子下面吧
XDSoft 说：
你这个简单

秋枫 · 发表于 2002-9-15 23:22:53

完全理解后，改写上面那个程序，比较简单了。

[FONT=courier new]
;;; 这个函数的功能相当于VLISP中的vl-symbol-name,
;;; 这里给出了纯AutoLISP的实现方法
(defun Sym->Str (sym / tmp symname)
(setq tmp (eval sym))
(set sym 0) ; 如果sym中代表的变量为nil, 将不出现在atoms-family中
(setq symname (nth (- (length (atoms-family 0))
(length (member sym (atoms-family 0)))
)
(atoms-family 1)
)
)
(set sym tmp)
symname
)
;;; 测试:
;;;$ (sym->str 'abc)
;;;"ABC"
[/FONT]

XDSoft · 发表于 2002-9-15 23:25:32

秋风，如何理解的，跟大家说说。

秋枫 · 发表于 2002-9-15 23:31:31

因为一个函数，就是一个list, 就这么简单。

在vlisp中，事情有点不同。
所以，vlisp保留了与autolisp完全兼容的函数定义方式，defun-q函数。

秋枫 · 发表于 2002-9-15 23:47:56

在autolisp中，defun不是必须的。定义函数也可以用setq ,set来定义

(setq add '((x y) (+ x y)))

(set 'add '((x y) (+ x y)))

(defun add (x y) (+ x y))

等价。

梦断江南 · 发表于 2004-10-17 01:50:32

通过链接又翻到旧帖子了.测试了一下
;;; 测试:
;;;$ (sym->str 'abc)
;;;"ABC"
(sym->str 'list)
"LIST"
_$
; 用户警告: 给保护符号赋值: LIST <- 0
_1_$ ;;进入中断了.... ??? 看来还不能完全等同于 vl-symbol-name;;当然这不是这个帖子的主题.
(vl-symbol-name 'list) -> "LIST"

应该加个判断
[php]
(defun Sym->Str (sym / tmp symname)
 (setq tmp (eval sym))
 (if (not (member sym (atoms-family 0)))(set sym 0)) ; 如果sym中代表的变量为nil, 将不出现在atoms-family中.
 (setq symname (nth (- (length (atoms-family 0))
(length (member sym (atoms-family 0)))
 )
 (atoms-family 1)
)
 )
 (set sym tmp)
 symname
)
[/php]
这回可以了:
(sym->str 'abc) ->"ABC"
(sym->str 'list) ->"LIST"

这个函数是利用了(atoms-family 参数)的特性
当参数=0,返回符号列表.当=1返回符合字符列表(字符串格式)
如果
(Sym->Str sym ) 中sym是原有符号,直接取出.
如果不是,设置sym为0,或其他的什么.nil也可以.这样cad里面就多了这样一个符号,再通过 atoms-family 取出其文本格式

本贴提到的list的用法很有意思

aeo · 发表于 2004-10-18 23:08:27

(set sym tmp) ;;;不是还是赋值了吗???

[php]
(defun Sym->Str(sym / r temp)
  (if (not(setq temp(eval sym)))(set sym 0))
  (setq r(nth(-(length (atoms-family 0))
            (length (member sym (atoms-family 0)))
         )
      (atoms-family 1)
      )
  )
  (if (not temp)(set sym nil))
  r
)
[/php]

aeo · 发表于 2004-10-18 23:25:27

其实以前是这样写的:
[php]
(defun every->str(any / a r)
  (setq a(open "acad.ac$""w"))
  (prin1 any a)
  (close a)
  (setq a(open "acad.ac$""r"))
  (setq r(read-line a))
  (close a)
  r
)
[/php]
命令: (setq pt(getpoint))
(18383.5 6975.97 0.0)

命令: (every->str 'pt)
"PT"

命令: (every->str pt)
"(18383.5 6975.97 0.0)"

命令: (every->str 'list)
"LIST"

梦断江南 · 发表于 2004-10-18 23:34:09

aeo, 你用(sym->str 'list) 测试一下你的函数
再试试我改的

---哦,说的是12贴
这么快又有回帖了啊,上面的程序不错:)

账号		自动登录	找回密码
密码			立即注册

Dreamer 该用户已被删除	发表于 2002-9-15 19:02:17 \| 显示全部楼层提示: 作者被禁止或删除内容自动屏蔽
Dreamer 该用户已被删除	论坛插件加载方法发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
	回复支持反对使用道具举报

[讨论]：提取符号的符号名

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

浏览过的版块