yang686526

这个lisp源代码中分解功能为什么用不了呢？高手请教！
www.dimcax.com
这个lisp源代码中分解功能为什么用不了呢？高手请教！
为什么“explode”和“overkill"这两个功能用不了呢？
另外怎样在后面加”欢迎使用“四个字？
(defun c:bchj()
(if(not (tblsearch "layer" "up"))
(command "layer" "n" "up" ""))
(if(not (tblsearch "layer" "lp"))
(command "layer" "n" "lp" ""))
(setq se (ssget "all" '((0 . "dimension"))))
(command "erase" se "")
(setq alal (ssget))
(command "overkill" alal "" "")
(command "explode" "all" "")
(setq up (ssget))
(setq lp (ssget))
(command "change" up "" "p" "layer" "up" "c" "7" "")
(command "change" lp "" "p" "layer" "lp" "c" "7" "")
(princ))

图片：

这个程序可解决你的问题。
(defun c:qjpoint ( / ss n i j ent1 en ent2 en1 pp1 pp2 p1 p2 m points ppp1 )
(setq ss (ssget))
(if ss
(setq n (sslength ss) points nil)
)
(setq i 0 j 0)
(while (< i n)
(setq j (1+ i))
(setq ppp1 nil ent1 (ssname ss i) en (entget ent1) pp1 (cdr (assoc 10 en)) pp2 (cdr (assoc 11 en)))
(while (< j n)
(setq k nil ent2 (ssname ss j) en1 (entget ent2) p1 (cdr (assoc 10 en1)) p2 (cdr (assoc 11 en1)))
(setq ppp1 (inters pp1 pp2 p1 p2))
(if (/= ppp1 nil)
(progn
(if (= points nil)(setq points (list ppp1)))
(setq m (length points) i1 0)
(repeat m
(setq p2 (nth i1 points) dd (rtos (distance ppp1 p2) 2 4))
(prompt dd)(terpri)
(if (= dd "0")(setq k "1" m 0)(setq i1 (+ i1 1)))
) ;-m
(if (= k "1")()(setq points (cons ppp1 points)))
))
(setq j (+ j 1))
) ;-j
(setq i (+ i 1))
) ;-i
(princ points)
(princ (strcat "\n共有交点" (itoa (length points)) "个"))
(princ)
)
;;;;上图中求出三个交点。
gbg

谢谢