[求助]奇怪.lsp程序有时能用,但提示intersect 所选对象太多
 

[求助]奇怪.lsp程序有时能用,但提示intersect 所选对象太多
www.dimcax.com
[求助]奇怪.lsp程序有时能用,但提示intersect 所选对象太多
做了个插入参照程序,一般情况运行正常,但有时候cad老是提示intersect 所选对象太多 导致程序出错 不知道怎么回事?是插入的块太多么?
怎么解决?各位大大帮帮忙啊
d
我是想把以前非参照图框改为参照的,但图框有些内容还要保留..批量修改时.多选几个就会出现intersect 所选对象太多 导致程序出错,
以下是源码:
(defun c:tk ( / inspt xa-ent plst nlst ent inspt pt len sca newent x y pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 ss-oldtk oldla ptcmp1 ptcmp2 fileflag)
(command "undo" "be")
(setvar "cmdecho" 0)
(princ"\n支持当前坐标系,选择要替划的图框")
(if (setq ss-oldtk (ssget '((8 . "市政图框"))))
(progn
(setq pliness (ssget "p" '((0 . "lwpolyline") (40 . 0.0) (90 . 4) (70 . 1)))) ;;;;70为闭合，90为四边形 40为线宽为0

(initget "s" )
(setq fileflag (getkword "\n选取要参照的图框<s更改> <回车默认>"))
(setq filename "e:\\cad简化命令")
(if (or (= fileflag "s") (= (findfile filename) nil) )
(setq filename (getfiled "选取要参照的图框" "" "dwg" 2))
)
(setq fileflag nil)
(if filename
(progn

(setq olderr *error*)
;;;;错误函数;;;
(defun *error* (msg)
(princ "\n程序出错!")
(command "layer" "s" oldla "")
(command "undo" "end")
(setq *error* olderr)
(princ)
)
;;;
(setq oldla (getvar "clayer"))
(command "layer" "s" "市政图框" "")
(setq i 0 )
(repeat (sslength pliness)
(setq plst '() nlst '())
(setq ent (entget (ssname pliness i)))
(mapcar '(lambda (x)
(if (= (car x) 10)
(setq plst (cons (trans (cdr x) 0 1 ) plst) ) )
)
ent
);mapcar
;;;根据坐标x轴大小排列;;;
(setq nlst (vl-sort plst
(function (lambda (e1 e2)
(< (car e1) (car e2) )
) ) )
)
;;;寻找左下角点;
(setq ptcmp1 (nth 0 nlst))
(setq ptcmp2 (nth 1 nlst))
(if (< (cadr ptcmp1) (cadr ptcmp2))
(setq inspt ptcmp1)
(setq inspt ptcmp2)
)
(setq pt (nth 2 nlst))
(setq len (abs(- (car pt) (car inspt) )) )
(setq sca (/ len 410 ))
(setq x (car inspt))
(setq y (cadr inspt))
(setq pt1 (list (+ x (* sca 120)) (+ y (* sca 5))) )
(setq pt2 (list (+ x (* sca 195)) (+ y (* sca 12))) )
(setq pt3 (list (+ x (* sca 335)) (+ y (* sca 12))) )
(setq pt4 (list (+ x (* sca 360)) (+ y (* sca 18))) )
(setq pt5 (list (+ x (* sca 375)) (+ y (* sca 5))) )
(setq pt6 (list (+ x (* sca 405)) (+ y (* sca 12))) )
(setq pt7 (list (+ x (* sca 355)) (+ y (* sca 268))) )
(setq pt8 (list (+ x (* sca 405)) (+ y (* sca 280))) )
(setq pt9 (list (+ x (* sca 405)) (+ y (* sca 266))) )
(setq pt10 (list (+ x (* sca 20)) (+ y (* sca 22))) )
(setq ss1 (ssget "w" pt1 pt2 '((8 . "市政图框")) ))
(setq ss2 (ssget "w" pt3 pt4 '((8 . "市政图框")) ))
(setq ss3 (ssget "w" pt5 pt6 '((8 . "市政图框")) ))
(setq ss4 (ssget "w" pt7 pt8 '((8 . "市政图框")) ))
(setq ss5 (ssget "w" pt9 pt10 '((8 . "市政图框")) )) ;;图框内选择集
;;;;;
(defun ss-del (ss-1 ss-2 / ss1 ss2 n ent ents newss);;;ss-2中删除ss-1
(setq n 0)
(repeat (sslength ss-1)
(setq ents (entget (ssname ss-1 n)))
(setq ent (cdr (assoc -1 ents)))
(setq newss (ssdel ent ss-2))
(setq n (+ n 1))
)
newss
);;defun
(if (/= ss1 nil)
(setq ss-oldtk (ss-del ss1 ss-oldtk));;;图层中要保留的图框内容
)
(if (/= ss2 nil)
(setq ss-oldtk (ss-del ss2 ss-oldtk))
)
(if (/= ss3 nil)
(setq ss-oldtk (ss-del ss3 ss-oldtk))
)
(if (/= ss4 nil)
(setq ss-oldtk (ss-del ss4 ss-oldtk))
)
(if (/= ss5 nil)
(setq ss-oldtk (ss-del ss5 ss-oldtk))
)
(command "_xref" "" filename inspt sca "" 0)
(setq i (+ i 1))
);repeat
(command "erase" ss-oldtk "")
);progn
(alert "\n没找到参照图框!!!!")
);if filename
) ;;pgogn ss-oldtk
(alert "\n只适用于[410x285]图框!!!!")
):if ss-oldtk
(setq olderr *error*)
(command "layer" "s" oldla "")
(command "undo" "end")
(princ)
)
该文件为 autocad r14 文件，请使用idrop将图形拖放到autocad中直接打开。
d
程式中用command函数运行时，当捕捉点打开时，图形缩放比较小时，就很容易出现这样的错误,
可以在command函数前面加上 （setvar "osmode" 0) 把捕捉点关闭.
d
喽..原来如此啊..多谢楼上了.以前都不太注意..只是出错了才加上这句..
d