永发信息网

请大侠们帮忙看一下这段LISP程序哪个地方有错误,我加载后用不了,应该是有错。能不能帮忙改改,有追加的

答案:1  悬赏:30  手机版
解决时间 2021-03-17 11:29
  • 提问者网友:夢醒日落
  • 2021-03-16 16:58
程序1 :cz.lsp
(defun c:cz()
(selq b (getstring "1屏幕拾取/2键入:"))
(if(=b"1")
(list(setq c (entget (ssnam (ssget) 0)))
(setq a (cdr (assoc 1 c)))
(setq a1 (cdr (assoc 8 c)))
(setq a2 (cdr (assoc 62 c)))
(setp ss (ssget "x" (list (cons 1 a)
(cons 8 a1))))))
(if(=b"2")

(list(setq a(getstring "要查找的字符串:
"))
(setq a1 (getstring "字符串所在图层:"))
(setq ss (ssget "x" (list (cons 1 a)(
cons 8 a1))))))
(setq i (sslength ss))
(setq a entget (ssname ss j)))
(setq R(* 1 (cdr(assoc 40 a))))
(setq R1(*1.1(cdr(assoc 40 a))))

(setq R2(*1.2(cdr(assoc 40 a))))
(setq pt(mapcar '+(list(/r2)(/r2) 0
(cdr(assoc 10 a))))
(command "color" 1)
(command "circle" pt r)
(command "color" 2)
(command "circle" pr r1)
(command "color" 6)
(command "circle" pr r2)
(setq j(+ j 1)))
(setq b ""))
在命令行键入"a"回车,系统提示"1屏幕拾取/2键入:".若键入1回车,系统提示 选择对象。 此时用光标直接在屏幕上点取欲找查的字符串后回车,计算机则自动查找出与点取字符串内容相同且在同一图层上的字符串,并以每一字符串的基点为圆心用红,黄,紫三种颜色的同心圆标记出来,若键入2回车则提示“要查找的字符串”键入要查找的字符串后回车,接着提示“字符串所在图层”,键入图层后回车,计算机则自动查找出与点取字符串内容相同且在同一图层上的字符串,并以每一字符串的基点为圆心用红,黄,紫三种颜色的同心圆标记出来。若在提示字符串所在图层时键入*则可标出所有图层上的,最后b回车,清除所有标记。
我在网上找的程序,下面是它的注释,我加载后怎么用不了,求大侠们指教,如果能用了,有追加的。
最佳答案
  • 五星知识达人网友:woshuo
  • 2021-03-16 17:24
错误太多了,快疯了……
(defun c:cz ()
(setq b (getstring "1屏幕拾取/2键入:"))
(if (= b "1")
(list (setq c (entget (ssname (ssget) 0)))
(setq a (cdr (assoc 1 c)))
(setq a1 (cdr (assoc 8 c)))
(setq a2 (cdr (assoc 62 c)))
(setq ss (ssget "x" (list (cons 1 a) (cons 8 a1))))
)
)
(if (= b "2")
(list (setq a (getstring "要查找的字符串:"))
(setq a1 (getstring "字符串所在图层:"))
(setq ss (ssget "x" (list (cons 1 a) (cons 8 a1))))
)
)
(setq i (sslength ss))
(setq j 0)
(while (< j i)
(setq a (entget (ssname ss j)))
(setq R (* 1 (cdr (assoc 40 a))))
(setq R1 (* 1.1 (cdr (assoc 40 a))))
(setq R2 (* 1.2 (cdr (assoc 40 a))))
(setq pt (mapcar '+ (list (/ r 2) (/ r 2) 0) (cdr (assoc 10 a))))
(command "-color" 1)
(command "circle" pt r)
(command "-color" 2)
(command "circle" pt r1)
(command "-color" 6)
(command "circle" pt r2)
(setq j (+ j 1))
)
(setq b "")
)
我要举报
如以上回答内容为低俗、色情、不良、暴力、侵权、涉及违法等信息,可以点下面链接进行举报!
点此我要举报以上问答信息
大家都在看
推荐资讯