【Gu_xl】输出函数局部变量符号表的小工具(源码)

1993063

版主精品再现

redcat

是不是用到了递归算法

fawn_lgc

非常有用，强烈支持。
不过在对付复杂程序还是有问题，错误: 参数类型错误: stringp nil
使用有些麻烦，如果能做成函数更好。
例如：（fvl 文件名 函数名) 返回值： 函数包括变量和完整程序

在下面程序使用出现错误

1. (defun get_ltscale(elist / old-elist *error* entltype pattern_length ltscale old-elist pt0 pt1 boolean motion code
   
2.         ltscale eltscale new_eltscale n dimdec fawn)
   
3. 
   
4.     (defun *error* (msg)
   
5.       (if (and (/= msg "Function cancelled")(/= msg "函数被取消"))
   
6.   (princ (strcat "<动态线型比例>功能" msg "\n"))
   
7.   (if motion(progn(fa-grdraw)(entmod hatch-elist)(setq hatch-elist nil)(ddmodify ename)))
   
8.   )
   
9.       (princ)
   
10.       );;(redraw)
    
11.     (defun fa-grdraw()
    
12.        (if(= 'list(type pt1))
    
13.    (grdraw pt1 pt0 -1)
    
14.    )
    
15.       )
    
16. 
    
17.     (setq auto_ltscale nil)
    
18.     (setq entltype(strcase(if(= eltype "BYLAYER")(cdr(assoc 6(tblsearch "layer" elayer)))eltype)))
    
19.     (if(not ltnmlst)(make_lt_lists))
    
20.     (setq n (vl-position eltype ltnmlst)leng (1- (length ltnmlst))dimdec(getvar"dimdec")
    
21.     ltscale (getvar "LTSCALE") old-elist elist pt0 (cadr (grread T 5 0)) boolean T
    
22.     pattern_length(cdr (assoc 40 (tblsearch "ltype" entltype))))
    
23.     (if(= pattern_length 0.0)(setq  pattern_length 1))
    
24.     (if(setq pt1 (osnap pt0 "nea"))(setq pt0 pt1 pt1 nil))
    
25.     ;;(setq VIEWCTR(getvar"VIEWCTR")VIEWSIZE (getvar"VIEWSIZE")VSMAX(getvar"VSMAX")VSMIX(getvar"VSMIN"))
    
26.     (princ"\n动态线型,按 +、- 切换填充图案:")
    
27.     (setq motion (grread T 15 0))    ;;动态绘图
    
28.     (setq code(car motion))
    
29.     (setq pt1(car (cdr motion)))
    
30.     (fa-grdraw)
    
31.     (setq fawn T)
    
32.     (while boolean
    
33.       (setq motion (grread T 15 0))    ;;动态绘图
    
34.       (redraw)
    
35.       (setq code(car motion))
    
36.       (setq pt1(car (cdr motion)))
    
37.       (fa-grdraw)
    
38.       (cond ((= code 5) ;鼠标移动
    
39.        (setq new_eltscale (atof(rtos (/(distance pt1 pt0) pattern_length ltscale) 1 dimdec)))
    
40.        (if (/= eltscale new_eltscale)
    
41.          (progn
    
42.      (setq eltscale new_eltscale)
    
43.      (emod eltscale 48);;修改对象数据
    
44.      (entmod elist);;修改对象图形显示
    
45.      )))
    
46.       ((= code 3)(setq eltscale new_eltscale)(setq boolean nil))
    
47.       ;鼠标左键按下;;保存线型比例eltype;;退出循环
    
48.       ((or(and (= code 2)(= 13 (car (cdr motion))))(= code 11)(= code 25))(setq boolean nil))
    
49.       ;;;回车键按下 或者;鼠标右键按下,有的鼠标设置为code = 25;;退出循环
    
50.       ((and (= code 2)(or(= 45 pt1)(= 43 pt1)(= 61 pt1))) ;- +
    
51.        (setq n(if(= 45 pt1)(if(= n 0)leng (1- n))(if(= n leng)0 (1+ n)))eltype(nth n ltnmlst))
    
52.        (emod eltype 6)
    
53.        (entmod elist);;修改对象图形显示
    
54.        (princ(strcat"\n线型名称:"eltype))
    
55.        )
    
56.       )
    
57.       )
    
58.     (fa-grdraw)
    
59.     (if(/= code 3)(entmod old-elist));;还原图形显示
    
60.     )

(defun get_ltscale(elist / old-elist *error* entltype pattern_length ltscale old-elist pt0 pt1 boolean motion code<br />         ltscale eltscale new_eltscale n dimdec fawn)<br /> <br />     (defun *error* (msg)<br />       (if (and (/= msg "Function cancelled")(/= msg "函数被取消"))<br />   (princ (strcat "<动态线型比例>功能" msg "\n"))<br />   (if motion(progn(fa-grdraw)(entmod hatch-elist)(setq hatch-elist nil)(ddmodify ename)))<br />   )<br />       (princ)<br />       );;(redraw)<br />     (defun fa-grdraw()<br />        (if(= 'list(type pt1))<br />    (grdraw pt1 pt0 -1)<br />    )<br />       )<br /> <br />     (setq auto_ltscale nil)<br />     (setq entltype(strcase(if(= eltype "BYLAYER")(cdr(assoc 6(tblsearch "layer" elayer)))eltype)))<br />     (if(not ltnmlst)(make_lt_lists))<br />     (setq n (vl-position eltype ltnmlst)leng (1- (length ltnmlst))dimdec(getvar"dimdec")<br />     ltscale (getvar "LTSCALE") old-elist elist pt0 (cadr (grread T 5 0)) boolean T<br />     pattern_length(cdr (assoc 40 (tblsearch "ltype" entltype))))<br />     (if(= pattern_length 0.0)(setq  pattern_length 1))<br />     (if(setq pt1 (osnap pt0 "nea"))(setq pt0 pt1 pt1 nil))<br />     ;;(setq VIEWCTR(getvar"VIEWCTR")VIEWSIZE (getvar"VIEWSIZE")VSMAX(getvar"VSMAX")VSMIX(getvar"VSMIN"))<br />     (princ"\n动态线型,按 +、- 切换填充图案:")<br />     (setq motion (grread T 15 0))    ;;动态绘图<br />     (setq code(car motion))<br />     (setq pt1(car (cdr motion)))<br />     (fa-grdraw)<br />     (setq fawn T)<br />     (while boolean<br />       (setq motion (grread T 15 0))    ;;动态绘图<br />       (redraw)<br />       (setq code(car motion))<br />       (setq pt1(car (cdr motion)))<br />       (fa-grdraw)<br />       (cond ((= code 5) ;鼠标移动<br />        (setq new_eltscale (atof(rtos (/(distance pt1 pt0) pattern_length ltscale) 1 dimdec)))<br />        (if (/= eltscale new_eltscale)<br />          (progn<br />      (setq eltscale new_eltscale)<br />      (emod eltscale 48);;修改对象数据<br />      (entmod elist);;修改对象图形显示<br />      )))<br />       ((= code 3)(setq eltscale new_eltscale)(setq boolean nil))<br />       ;鼠标左键按下;;保存线型比例eltype;;退出循环<br />       ((or(and (= code 2)(= 13 (car (cdr motion))))(= code 11)(= code 25))(setq boolean nil))<br />       ;;;回车键按下 或者;鼠标右键按下,有的鼠标设置为code = 25;;退出循环<br />       ((and (= code 2)(or(= 45 pt1)(= 43 pt1)(= 61 pt1))) ;- +<br />        (setq n(if(= 45 pt1)(if(= n 0)leng (1- n))(if(= n leng)0 (1+ n)))eltype(nth n ltnmlst))<br />        (emod eltype 6)<br />        (entmod elist);;修改对象图形显示<br />        (princ(strcat"\n线型名称:"eltype))<br />        )<br />       )<br />       )<br />     (fa-grdraw)<br />     (if(/= code 3)(entmod old-elist));;还原图形显示<br />     )

cnks

下载回复

bridgewind

不错，学习了。。

bluelisp

好东西好东西好东西好东西好东西

jxjaxa

谢谢版主共享

namezg

这个太好了，正需要，解决了每次一个一个写的麻烦。

xshrimp

看看G版程序 学习一下

lgttblue

学习下