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

npu349

做了个插入参照程序,一般情况运行正常,但有时候CAD老是提示intersect 所选对象太多 导致程序出错 不知道怎么回事?是插入的块太多么?

怎么解决?各位大大帮帮忙啊

npu349

我是想把以前非参照图框改为参照的,但图框有些内容还要保留..批量修改时.多选几个就会出现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简化命令\\Tyt\\A3sztk.dwg")
  (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)
)

祥子

 程式中用COMMAND函数运行时，当捕捉点打开时，图形缩放比较小时，就很容易出现这样的错误,

可以在COMMAND函数前面加上 （setvar "osmode" 0) 把捕捉点关闭.

npu349

喽..原来如此啊..多谢楼上了.以前都不太注意..只是出错了才加上这句..

真是太感谢了 昨天晚上弄了一晚上也没弄明在哪里错了 原来就在这里 哈哈 多谢 多谢 无比感谢 我都不知道该怎么谢啦 哈哈哈哈哈

jdjb

大侠啊  太感谢了 昨天晚上捣鼓一晚上没弄明白 今天一看茅塞顿开 太感谢啦 无比感谢 哈哈哈哈哈

heartwind

谢谢大侠。