[求助]：转换图层的问题？

果单皮 · 发表于 2005-7-23 10:25:16

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

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

×

这个程序是想实现，只要点击字母b+数字（>6）就可以把所选

对象转到相应的图层，我运行了一下，出错了，转换不了，

不知是哪个环节出了问题？哪位高人帮忙看看~~THX

(defun c:bbb()
(setq n 100)
(while (>= n 6)
(eval (read (strcat "(defun c:b" (itoa n) " (/ gp) (setq gp (ssget)) nil (command \"change\" gp "" \"p\" \"la\" "(itoa n)" \"color\" \"BYLAYER\" "")) \"\"))" )))
(setq n (1- n))
)
)

fools · 发表于 2005-7-23 16:38:54

说实话，我不觉得这样做很有必要，函数开销太大，不值得。下面这个小程序只不过多了一步，并不麻烦
[php]
(defun c:aaa(/ ssg lname)
  (setq ssg (ssget))
  (setq lname (getstring "请输入层名:"))
  (command "change" ssg "" "p" "la" lname "c" "bylayer" "")
  (princ)
)
[/php]
如果你执意要按原思路进行下去，仔细看看下面的程序与你原先的区别：
[php]
(defun c:bbb ()
  (setq n 100)
  (while (>= n 6)
(eval
   (read
   (strcat "(defun c:b"
      (itoa n)
   " (/ gp) (setq gp (ssget)) (command \"change\" gp \"\" \"p\" \"la\" "
   (itoa n)
   " \"color\" \"BYLAYER\" \"\"))"
   );end strcat
   );end read
);end eval
(setq n (1- n))
  );end while
)
[/php]
还有一个方法可供参考，先生成一个包含一系列函数集的文件，再调用它，这样做的好处是多了一个副产品（函数集文件），以备今后再次使用。下面的程序只是一个思路，正式编程还需要加入一些错误判断：
[php]
;;生成一个包含一组函数的文件
(defun c:ccc (/ f n)
  (if (null (findfile "new.lsp"))
(progn
   (setq f (open "new.lsp" "w"))
   (setq n 6)
   (repeat 95
      (write-line (strcat "(defun c:b" (itoa n) " (/ gp)") f)
      (write-line "  (setq gp (ssget))" f)
      (write-line
      (strcat "  (command \"change\" gp \"\" \"p\" \"la\" "
   (itoa n)
   " \"color\" \"BYLAYER\" \"\")"
      )
      f
   )
   (write-line "  (princ)" f)
   (write-line ")" f)
   (setq n (1+ n))
   );end repeat
   (write-line "(princ)" f)
   (close f)
   );end progn
);end if
  ;是否加载函数文件视需要而定
  ;(load "new")
)
[/php]

通过上两个程序可以看出来，通过read-line，strcat，read和eval的组合可以替代load函数，当然大家通常不会那样去加载文件。但这恰恰就是lisp语言最迷人和强大的地方，lisp是自己解释自己的语言。下面就接着上个程序写个替代load的函数：
[php]
(defun c:ddd (/ f all_line one_line one_func)
  (setq all_line "(")
  (if (findfile "new.lsp")
(progn
   (setq f (open "new.lsp" "r"))
   (while (setq one_line (read-line f))
       (setq all_line (strcat all_line one_line))
   )
   (setq all_line (strcat all_line ")"))
   (close f)
   (foreach one_func (read all_line)
      (eval one_func)
   );end foreach
);end progn
  );end if
)
[/php]

加工完善上一个程序，可以实现在任何文本文件中（不限lsp文件）加载部分lisp代码。方法是：先搜索文本中是否有“(defun”字串，然后开始计算左右括号数，当相等时，调用eval进行函数语句解释，然后再次搜索。。。（不过要注意字符串和注释段等诸多影响因素）

这里高手如云，诚惶诚恐得写了那么多代码，早已汗流夹背，请大家多批评指正。
也感谢eachy的鼓励和嘉奖，通过你的程序我学到了很多很有价值的东西，但学到的越多，发现不懂的更多。。。

果单皮 · 发表于 2005-7-23 17:34:59

哇哦，fools兄，你太棒了，感谢，这个问题一直困扰了我好久，今天终于解决了，高兴ing...

fools · 发表于 2005-7-23 17:50:53

楼上的太客气了，俗话说：闻道有先后，术业有专攻！
lisp易学难精，大家一起努力吧！

eachy · 发表于 2005-7-23 19:59:14

还可以这样，不用定义那么多命令，增加一个点选过程

(defun c:bbb (/ e el str lay ss)
(if (and (setq e (car (entsel "\n拾取典型文字: ")))
(= (cdr (assoc 0 (setq el (entget e)))) "TEXT")
(wcmatch (setq str (cdr (assoc 1 el))) "b#,b##,b###")
)
(progn
(setq lay (substr str 2))
(if (and (tblsearch "layer" lay)
(progn
(princ "\n选择修改对象....")
(setq ss (ssget))
)
)
(command ".chaprop" ss "" "la" lay "c" "bylayer")
)
)
)
(princ)
)

狂刀 · 发表于 2005-7-24 09:29:42

[php]
(defun c:tt(/ ss i e ent str)
  (setq ss (ssget '((0 . "TEXT")(1 . "b#,b##,b###")))
      i -1)
  (while (setq e (ssname ss (setq i (1+ i))))
   (setq ent (entget e)
         str (cdr(assoc 1 ent)))
   (entmod (subst (cons 8 (substr str 2))(assoc 8 ent)ent)
  )(princ)
)[/php]

aeo · 发表于 2005-7-24 11:06:43

大家肯定是理解错搂主的意思了.

他是要同时创建 b7 ~ b99的命令
b7就是改选到的实体到"7"层 ...

都是字符看都看不清，还是用表

(defun c:bbb( / fun n name)
(setq n 100)
(while (>= n 6)
(setq name (read(strcat"c:b" (itoa n)))
fun (list 'defun
name
'( / gp)
'(setq gp (ssget))
(append '(command "change"gp"""p""la")
(list (itoa n))
'("color" "BYLAYER" "")
)
)
)
(eval fun)
(setq n (1- n))
)
)

陌生人 · 发表于 2005-7-24 12:28:56

和aeo的类似
[php]
(defun c:tt ()
  (setq n 5)
  (while (< (setq n(1+ n)) 100)
(eval(read(strcat "(defun c:b" (itoa n) "()(fun " (itoa n) "))")))
  )(princ)
)
(defun fun (n / ss)
  (if (setq ss (ssget))
   (command "change" ss "" "p" "la" (itoa n) "c" "bylayer" "")
  )
)[/php]

userzhl · 发表于 2005-7-24 12:58:13

谢谢楼上，不过我都是用已作好的DWT画图的。

fools · 发表于 2005-7-24 13:55:56

我没有理解错，是用两种方法生成一系列函数的

chm · 发表于 2005-7-27 20:55:16

看得不是太明白
看来还得多加学习了

userzhluserzhl · 发表于 2005-7-27 23:41:47

我更喜欢这个有比例的直箭头
(defun c:jt (/ ang h2 jtl oldcm oldos pt1 pt2 pt3 scale)
  (setq oldcm (getvar "cmdecho"))
  (setq oldos (getvar "osmode"))
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (setq scale (getreal "\n请输入比例<100>:"))
  (if (= scale nil)
(setq scale 100)
  )
  (setq h2 (* 0.8 scale)
jtl (* 4 scale)
  )
  (setq pt1 (getpoint "\n请输入第一点:"))
  (setq pt3 (getpoint pt1 "\n请输入第二点:"))
  (setq ang (angle pt1 pt3))
  (setq pt2 (polar pt1 ang jtl))
  (command "pline" pt1 "w" 0 h2 pt2 "w" 0 0 pt3)
  (setvar "cmdecho" oldcm)
  (setvar "osmode" oldos)
  (princ "\n  ")
  (princ "\n继续使用pline命令")
  (princ)
)

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

[求助] [求助]：转换图层的问题？

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

相关帖子