编个小lisp，当选择实体超过一定数量就会卡住
编个lisp，将圆替换成块，当选择到的物体超过一定数量，程序运行就会卡住，改怎么解决呢？ 程序的思路很简单的，就是选择物体进入选择集，计数循环，然后取出圆心，调用插入命令插入块，删除原来的圆但是程序运行时候，如果圆数量少的时候，执行很快，当数量多到上千的时候，就会卡住
看不出程序有啥不对的地方，
请教各位高手，这个该怎么解决呢？ 1.贴上源码，贴上测试文件
2.acad版本。
个人理解，运行成千个命令速度是慢了很正常。 (defun C:IB(/ p l n e q m b w)
(setq oldblp (getvar "blipmode")
oldech (getvar "cmdecho")
olderr *error*
linetype1 (getvar "celtype")
layer1 (getvar "clayer")
color1 (getvar "cecolor")
)
(setvar "blipmode" 0)
(setvar "cmdecho" 0)
(defun *error* (msg)
(princ "\n")
(princ msg)
(setvar "blipmode" oldblp)
(setvar "cmdecho" oldech)
(setq *error* olderr)
(princ)
)
(setq w (getstring "\n请输入需要替换的块名，默认块名为“PT”: "))
(if (= w"") (setq w "PT"))
(prompt "\n请选择要转换的物体.")
(setq p (ssget))
(setq l 0 m 0 n (sslength p))
(while (< l n)
(setq q (ssname p l))
(setq ent (entget q))
(setq b (cdr (assoc 0 ent)))
;处理圆弧
(if (member b '("CIRCLE" "ARC"))
(progn
(if (assoc 6 ent) (setq linetype0 (cdr (assoc 6 ent))) (setq linetype0 "bylayer"))
(setq layer0 (cdr (assoc 8 ent)))
(if (assoc 62 ent) (setq color0 (cdr (assoc 62 ent))) (setq color0 "bylayer"))
(command "color" color0)
(command "layer" "s" layer0 "")
(command "linetype" "s" linetype0 "")
(command "insert" w (cdr (assoc 10 ent)) 1 1 0)
(setq m (+ 1 m))
(entdel q)
)
)
(setq l (+ 1 l))
)
(if (= 0 m)
(progn
(princ "\n\t没有任何可用实体被选中")
(princ)
)
)
(command "color" color1)
(command "layer" "s" layer1 "")
(command "linetype" "s" linetype1 "")
(setvar "blipmode" oldblp)
(setvar "cmdecho" oldech)
(setq *error* olderr)
(princ)
) edata 发表于 2013-12-19 00:11 static/image/common/back.gif
1.贴上源码，贴上测试文件
2.acad版本。
个人理解，运行成千个命令速度是慢了很正常。
cad2012-2014都试了一下，都是一样的，
在屏幕上能看到生成的物体，每次都在处理将近1000个左右以后就停滞了，cad进入卡住的状态
然后要过很长时间才继续完成 本帖最后由 liu22737 于 2013-12-19 09:40 编辑
fen00 发表于 2013-12-19 09:25 static/image/common/back.gif
cad2012-2014都试了一下，都是一样的，
在屏幕上能看到生成的物体，每次都在处理将近1000个左右以后就停 ...
你这个不慢才怪呢!
用这么多COMMAND，还在循环中用，
用entmake,subst,1+(ssget'((0 "CIRCLE,ARC"))) liu22737 发表于 2013-12-19 09:39 static/image/common/back.gif
你这个不慢才怪呢!
用这么多COMMAND，还在循环中用，
用entmake,subst,1+(ssget'((0 "CIRCLE,ARC")))
理解了，不用command,谢谢，我去试一下
但是如果用command命令，有啥能效率的技巧吗？ 本帖最后由 1993063 于 2013-12-18 16:22 编辑
(Defun C:tt ( / ask en i pt s1 san ss )
(setq san (cdr (Assoc 2 (Entget (car (entsel "\n图块"))))))
(initget 4 "Y N ")
(setq ask (getkword "\n删除圆[(Y)是/(N)否]<否>: "))
(if (not ask)(setq ask "N"))
(setqi -1 ss (ssget '((0 . "CIRCLE"))))
(progn
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq pt (cdr (Assoc 10 (Entget s1))))
(Entmake (list '(0 . "INSERT") (cons 2 san) (cons 10 pt)))
(if (= ask "Y")(Entdel s1))
)
)
(princ)
)
fen00 发表于 2013-12-18 16:20 static/image/common/back.gif
理解了，不用command,谢谢，我去试一下
但是如果用command命令，有啥能效率的技巧吗？
用多了command可以倒杯水在一边喝喝茶 写好了，但没时间发。。。。;圆、圆弧的圆心插入块，并删除圆、
;命令c2bc=circle 2=to b=block
(defun c:c2b(/ bs blk_n ss en p10 key_t)
(defun *error*_New (msg)
(if *error*_Old(setq *error* *error*_Old))
(if (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")
(princ)
)
(vla-EndUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)))
(princ)
)
(setq *error*_Old *error*)
(setq *error* *error*_New)
(if (and (princ "\n选择图块:")(setq bs(ssget ":E:S" '((0 . "INSERT"))))
(setq blk_n(cdr(assoc 2 (entget(ssname bs 0)))))
(princ "\n选择圆、圆弧:")
(setq ss(ssget '((0 . "arc,circle"))))
)
(progn
(initget"Yes No")
(and (setq key_t(getkword "\n是否删除源对象<Y>:"))
(setq key_t (strcase key_t)))
(vla-StartUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)))
(while (setq en(ssname ss 0))
(setq p10(cdr(assoc 10 (entget en))))
(entmake (list'(0 . "INSERT") (cons 2 blk_n) (cons 10 p10)))
(if (or (not key_t) (wcmatch "Y" key_t))(entdel en))
(setq ss(ssdel en ss))
)
(vla-StartUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)))
(if *error*_Old(setq *error* *error*_Old))
)
(princ "\n没有选择对象!")
)
(princ)
)
页:
[1]
2