lisp使用entdel出错_晓东CAD家园-论坛-A/VLISP-[求助]：用了一个lisp后出现的问题-用了一个lisp执行运行命令后，又用了Ctrl+Z，可能是撤销次数不够，CAD出现了不能先选...

谢楼上的几位朋友，

选项里设置是正确的

重新启动后，还是不行。

现在是运行这个lisp后，提示“函数错误”图层颜色变成黑色188了，生成的边界轮廓线不连贯，样条曲线也没有变成多段线。(以前把原点移动了，好像也有这种现象)

这是代码，是论坛上的，生成边界轮廓很不错。

;;边界轮廓线

(vl-load-com)

(defun c:j(/ viewpt maxmin spl2arc ss_add os cor qa ss n pt1 pt2 l_pt dis ent m)

(defun viewpt(/ a b c d x)

(setq b (getvar "viewsize") c (car (getvar "screensize")) d (cadr (getvar "screensize"))

a (* b (/ c d)) x (setq x (getvar "viewctr")) x (trans x 1 2) c (list (- (car x)  (/ a 2.0)) (- (cadr x) (/ b 2.0)) 0.0)

d (list (+ (car x) (/ a 2.0)) (+ (cadr x) (/ b 2.0)) 0.0) c (trans c 2 1) d (trans d 2 1)

)

(list c d)

)

(defun maxmin(lst / x n a b c d)

(setq x (car lst) a (car x) b (cadr x) c (car x) d (cadr x) n 1)

(repeat (max (- (length lst) 1) 0)

(setq x (nth n lst) a (min a (car x)) b (min b (cadr x)) c (max c (car x)) d (max d (cadr x)))

(setq n (1+ n))

)

(list (list a b) (list c d))

)

(defun spl2arc(ent / obj len num spt ept ss i pt1 pt2 pt3 s)

(setq obj (vlax-ename->vla-object ent)

len (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))

num (1+ (fix (/ len dis)))

num (if (= num 1) 2 num)

spt (vlax-curve-getStartPoint obj)

ept (vlax-curve-getEndPoint obj)

)

(command "_.divide" ent (* 2 num))

(setvar "cecolor" "1")

(setq ss (ssget "_p"))

(if (equal spt ept)

(setq i 1)

(setq i 0)

)

(setq pt3 spt)

(setq s (ssadd))

(repeat num

(setq pt2 (cdr (assoc 10 (entget (ssname ss i)))))

(if (/= num (/ (+ i 2) 2))

(setq pt1 (cdr (assoc 10 (entget (ssname ss (1+ i))))))

(setq pt1 ept)

)

(command "_.arc" pt3 pt2 pt1)

(ssadd (entlast) s)

(setq pt3 pt1)

(setq i (+ 2 i))

)

(command "_.erase" ss ent "")

(setvar "cecolor" "188")

s

)

(defun ss_add(s1 s2 / n)

(setq n -1)

(repeat (sslength s1)

(ssadd (ssname s1 (setq n (1+ n))) s2)

)

s2

)

(prompt "\n请选择要生成边界轮廓线的所有对象(图块轮廓要闭合)：")

(if (setq ss (ssget '((0 . "line,arc,circle,*polyline,spline,ellipse,insert"))))

(progn

(command "_.undo" "_be")

(setq os (getvar "osmode")

cor (getvar "cecolor")

qa (getvar "qaflags")

)

(setvar "osmode" 0)

(setvar "cmdecho" 0)

(setq n -1)

(repeat (sslength ss)

(vla-getboundingbox (vlax-ename->vla-object (ssname ss (setq n (1+ n)))) 'pt1 'pt2)

(setq l_pt (append l_pt (list (vlax-safearray->list pt1) (vlax-safearray->list pt2))))

)

(setq l_pt (maxmin l_pt)

pt1 (car l_pt)

pt2 (cadr l_pt)

dis (/ (distance pt1 pt2) 20)

pt1 (polar pt1 (angle pt2 pt1) dis)

pt2 (polar pt2 (angle pt1 pt2) dis)

)

(setq l_pt (maxmin (append (viewpt) (list pt1 pt2))))

(command "_.zoom" "_w" (car l_pt) (cadr l_pt))

(setvar "cecolor" "188")

(command "_.rectang" pt1 pt2)

(setq ent (entlast))

(command "_.boundary" "_a" "_o" "_r" "_i" "_y" "_b" "_n" ent ss "" "" (polar pt1 (angle pt1 pt2) (/ dis 2)) "")

(if (equal (entlast) ent)

(progn

(entdel ent)

(prompt "\n没有边界轮廓线！")

)

(progn

(entdel ent)

(command "_.erase" (ssget "c" pt1 pt1 '((0 . "region") (62 . 188))) "")

(setq m 0)

(if (setq ss (ssget "x" '((0 . "region") (62 . 188))))

(progn

(command "_.union" ss "")

(entmod (subst (cons 62 1) (cons 62 188) (entget (setq ent (entlast)))))

(command "_.explode" ent)

(setq ss (ssget "_p"))

(if (= (cdr (assoc 0 (entget (ssname ss 0)))) "REGION")

(progn

(setvar "qaflags" 1)

(command "_.explode" ss "")

(setq ss (ssget "_p"))

)

)

(if (ssget "p" '((0 . "spline,ellipse")))

(progn

(setq dis (abs (if (setq dis (getreal "\n请输入样条曲线或椭圆的取样距离：<3>")) dis 3.0)))

(if (= dis 0.0) (setq dis 600.0))

)

)

(setq n -1)

(repeat (sslength ss)

(setq ent (ssname ss (setq n (1+ n)))

name (cdr (assoc 0 (entget ent)))

)

(if (or (= name "SPLINE") (= name "ELLIPSE"))

(progn

(ssdel ent ss)

(setq ss (ss_add (spl2arc ent) ss))

(setq n (1- n))

)

)

)

(setq n -1)

(while (setq ent (ssname ss (setq n (1+ n))))

(if (entget ent)

(progn

(command "_.pedit" ent "_y" "_j" ss "" "")

(setq m (1+ m))

)

)

)

)

)

(if (setq ss (ssget "x" '((0 . "*polyline") (62 . 188))))

(progn

(setq n -1)

(repeat (sslength ss)

(entmod (subst (cons 62 1) (cons 62 188) (entget (ssname ss (setq n (1+ n))))))

)

(setq m (+ m (sslength ss)))

)

)

(if (= m 0)

(prompt "\n没有边界轮廓线！")

(prompt (strcat "\n生成" (itoa m) "条边界轮廓线！"))

)

)

)

(setvar "osmode" os)

(setvar "cecolor" cor)

(setvar "qaflags" qa)

(command "_.undo" "_e")

)

)

(princ)

)

(prompt "\n***边界轮廓线yad_outline***  YAD建筑")

(princ)