[LISP程序]：批量删除程序的一个莫名瑕疵，请高手指点

逐月飞鸿 · 发表于 2008-12-8 16:38:22

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

想在图纸中以长度520，角度为0的直线起点坐标，加减数值后，得到一个框选范围，这个范围内物体的都删除，这个程序运行有的时候正常，有的时候错误，搞了大半天，也没有明白问题出在哪里，请高手看看
问题1.过滤不太完全，就是有的时候520，角度为0的不能过滤出来删除。
2.有时候显示："命令: 错误 : 参数类型错误: 二维/三维点: nil”
程序代码如下：
;;==============================================================================
;==============================================================================
(defun c:ppe()
 (setq sv (ssget "I"' ((0 . "LINE")))) ;判断是否有已经有选择'''''''''''''''''''''''''''
 (if (= sv nil)(setq printtype (getstring "\nAuto-search DEL全部(模型+布局)[A]/部分[P]：<A>")))

 (if (or (= printtype "") (= printtype "A") (= printtype "a")) (setq sv (ssget "X" (list (cons 0 "line")))) (setq sv (ssget ' ((0 . "LINE")))) ) ;_ 结束if
 ;取得直线
 ;======================================================
 (command ".ucs" "W")
 (command "setvar" "dimzin" "0")
 (command "setvar" "DYNMODE" "0")
 (setq modetype (getvar "tilemode"))
(setq keyline "520.0")
 (setq keyang1 "0.0000")
 (setq keyang2 "6.2832")
 ;======至此完成输入数据处理=======
 (setq ls (sslength sv))
 (setq prpage 0)
 (setq s 0)
 (repeat ls
(setq vv (ssname sv s))
 ;得到sp，ep，mp的坐标-------------------------------------
(setq sp (cdr (assoc 10 (entget vv))))
(setq ep (cdr (assoc 11 (entget vv))))
 ;得到过程结束----------------------------------------------
(setq s_epdis (distance sp ep))
(setq Len (rtos s_epdis 2 1)) ;-----
(setq s_epang (angle sp ep))
(setq ang (rtos s_epang 2 4)) ;------

(if (and (= Len keyline) (or (= ang keyang1) (= ang keyang2)))
 (progn (setq s_prp1 sp)
 (setq prpage (+ prpage 1))
 (setq prscreemtext1 "\n正在DEL第\t")
 (setq prscreemtext2 "\t张图纸")
 (setq
 prscreemtext (strcat (strcat prscreemtext1 (itoa prpage)) prscreemtext2) ;_ 结束strcat
 ) ;_ 结束setq
 (princ prscreemtext)
 (command "modemacro" prscreemtext "")
 (setq ew1 (list (+ (car s_prp1) 225) (+ (cadr s_prp1) 23))) ;_ 结束setq
 (setq ew2 (list (+ (car s_prp1) 406) (+ (cadr s_prp1) 12))) ;_ 结束list
 (command "erase" "w" ew1 ew2 "")

 ) ;_ 结束progn
) ;_ 结束if
(setq s (+ s 1))
 ) ;_ 结束repeat
 (command "modemacro" " " "")
(princ)
) ;_ 结束defun
请高手指教

carrot1983 · 发表于 2008-12-8 20:59:46

1.临时关闭捕捉
(command "erase" "w" “none”ew1 "none"ew2 "")
2.提出一点建议，比较用equal,用法看函数帮助。

逐月飞鸿 · 发表于 2008-12-8 22:52:47

欣喜——高手出招了！谢谢carrot1983！

carrot1983 · 发表于 2008-12-9 08:58:02

[php]
;;REV By carrot1983 2008-12-09
(defun c:tt (/ dis e elist i lineangle linelength pt1 pt2 ss v10 v11)
  ;;初始化
  (setvar "cmdecho" 0)
  (command "._undo" "_begin")
  (setq dis 520)
  (if (not (setq ss (ssget "I" '((0 . "LINE")))))
(setq ss (ssget '((0 . "LINE"))))
  )

  ;;1.
  (if (and ss
   (setq i 0
   n 0
   )
   )
(progn
   (repeat (sslength ss)
;;2.1
(setq e (ssname ss i))
(setq elist (entget e))
(setq v10 (cdr (assoc 10 elist)))
(setq v11 (cdr (assoc 11 elist)))
(setq linelength (distance v10 v11))
(setq lineangle (angle v10 v11))
;;2.2
(if (and (equal linelength dis 0.0000001) ;_长度约等于520
   (or (equal lineangle 0 0.0000001) ;_角度约等于0
      (equal lineangle (* 2 pi) 0.0000001) ;_角度约等于360=2pi
   )
      )
   (progn
      (setq pt1 (list (+ (car v10) 225) (+ (cadr v10) 23)))
      (setq pt2 (list (+ (car v10) 406) (+ (cadr v10) 12)))
      ;;3.
      (if (setq ss (ssget "w" pt1 pt2))
      (progn
(setq text (strcat "\n正在删除第"
   (itoa (setq n (1+ n)))
   "张图纸"
   )
)
(princ text)
(command "modemacro" text "")
(command "._erase" ss "")
      )
      )
   )
)
;;2.3
(setq i (1+ i))
   )
)
  )
  (command "._undo" "_end")
  (princ)
)
[/php]

PS: 如果要全选，那就在选择对象时输入all

逐月飞鸿 · 发表于 2008-12-9 10:45:56

一个一个点击520，角度为0的直线可以了，就是输入all的显示如下：
命令: tt

选择对象: all
找到 33302 个

选择对象:
错误 : 参数类型错误: lselsetp nil

这个问题是因为什么？先谢了

carrot1983 · 发表于 2008-12-9 10:59:30

没有测试图，就没有调试了。。。
调试一下就知道哪里错了。。。

如下：将ss改成ss1即可

   ;;3.
      (if (setq ss1 (ssget "w" pt1 pt2))
      (progn
      (setq text (strcat "\n正在删除第"
               (itoa (setq n (1+ n)))
               "张图纸"
            )
      )
      (princ text)
      (command "modemacro" text "")
      (command "._erase" ss1 "")

逐月飞鸿 · 发表于 2008-12-9 11:13:02

我改了，还是会出现这个问题
错误 : 参数类型错误: 二维/三维点: nil，这个地方我一致搞不懂是什么原因】
这个是测试文件
里面的关键线长是420，测试的时候我已经改了
如果程序正常的话，应该是编制以后的文字都删除了
现在是一个个点击可以
输入all，就会出现上述错误
？？？？？？？？？？？？？？？
请指教！

carrot1983 · 发表于 2008-12-9 15:22:28

[php]
;;REV1.1 By carrot1983 2008-12-09
(defun c:tt (/ e elist i lineangle linelength pt1 pt2 ss v10 v11 ss1)
  ;;初始化
  (setvar "cmdecho" 0)
  (command "._undo" "_begin")
  (if (not (setq ss (ssget "I" '((0 . "LINE")))))
(setq ss (ssget '((0 . "LINE"))))
  )

  ;;核心程序
  (if (and ss
   (setq i 0
   n 0
   )
   )
(progn
   (repeat (sslength ss)
(if (and (setq e (ssname ss i))
   (setq elist (entget e))
   (setq v10 (cdr (assoc 10 elist)))
   (setq v11 (cdr (assoc 11 elist)))
   (setq linelength (distance v10 v11))
   (setq lineangle (angle v10 v11))
   (equal linelength 420 0.0000001) ;_长度约等于420
   (or (equal lineangle 0 0.0000001) ;_角度约等于0
      (equal lineangle (* 2 pi) 0.0000001) ;_角度约等于360=2pi
   )
   (setq pt1 (list (+ (car v10) 225) (+ (cadr v10) 23)))
   (setq pt2 (list (+ (car v10) 406) (+ (cadr v10) 12)))
   (setq ss1 (ssget "c" pt1 pt2))
      )
   (progn
      (setq text (strcat "\n正在删除第"
         (itoa (setq n (1+ n)))
         "张图纸"
         )
      )
      (princ text)
      (command "modemacro" text)
      (command "._erase" ss1 "")
   )
)
(setq i (1+ i))
   )
   (command "modemacro" " ")
)
(princ "\n重新选择...")
  )

  (command "._undo" "_end")
  (princ)
)
[/php]

选择对象: all
找到 474 个

选择对象:
正在删除第1张图纸
正在删除第2张图纸
正在删除第3张图纸
正在删除第4张图纸
正在删除第5张图纸
正在删除第6张图纸
正在删除第7张图纸
正在删除第8张图纸
正在删除第9张图纸
正在删除第10张图纸
正在删除第11张图纸
正在删除第12张图纸
正在删除第13张图纸
正在删除第14张图纸
正在删除第15张图纸
正在删除第16张图纸
正在删除第17张图纸
正在删除第18张图纸

PS: 这个 xxxx的图纸有VBA宏提示。
不知道是不是病毒。。。呵呵

逐月飞鸿 · 发表于 2008-12-9 15:32:50

carrot1983
谢谢！对你的热心帮助内心感激不已！对你的多次打扰----说句：谢谢！谢谢！
真的很感激你！

carrot1983 · 发表于 2008-12-9 21:43:55

最初由逐月飞鸿发布
[B]carrot1983
谢谢！对你的热心帮助内心感激不已！对你的多次打扰----说句：谢谢！谢谢！
真的很感激你！ [/B]

希望你继续完善自己的程序。。。
多写程序就会知道怎么完善了

xyp1964 · 发表于 2008-12-10 00:18:27

;; 需要通用函数XYPLib.vlx的支持

[FONT=courier new](defun c:ppe ()
(cmdla0)
(setvar "osmode" 0)
(xyp-initSet '(ukw) '("A"))
(setq ukw (UKWORD 1 "A P" "A-全部/P-局部" ukw)
i -1
)
(if (= ukw "A")
(setq ss (ssget "X" '((0 . "LINE"))))
(setq ss (ssget '((0 . "LINE"))))
)
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq p1 (xyp-get-MinMaxPoint s1 1)
p9 (xyp-get-MinMaxPoint s1 9)
)
(if (and (= (distance p1 p9) 520.0) (= (angle p1 p9) 0))
(progn
(princ (strcat "\n正在删除第 " (itoa (+ i 1)) " 张图纸"))
(setq p1 (xyp-get-Pt2XY p1 225 23)
p2 (xyp-get-Pt2XY p1 406 12)
)
(command "erase" "w" p1 p2 "")
)
)
)
(cmdla0)
)[/FONT]

逐月飞鸿 · 发表于 2008-12-10 08:15:44

谢谢xyp1964版主，谢谢！

zml84 · 发表于 2008-12-10 13:07:45

(defun C:TT (/ SS N I ENT PT10 PT11 PT1 PT2 SS1)
;;
(setvar "cmdecho" 0)
(command "._undo" "_begin")
(setq N 0
I 0
)
;;核心
(if (or (setq SS (ssget "I" '((0 . "LINE"))))
(setq SS (ssget '((0 . "LINE"))))
)
(repeat (sslength SS)
(setq ENT (entget (ssname SS I))
PT10 (cdr (assoc 10 ENT))
PT11 (cdr (assoc 11 ENT))
)
(and
;;对比距离
(equal (distance PT10 PT11) 420 1e-6)
(if (< (car PT11) (car PT10)) ;关键一步。
(setq TMP PT10 ;交换坐标并非为了对比角度方便，
PT10 PT11 ;重要的是后续计算的需要。
PT11 TMP
)
)
;;对比角度
(equal (angle PT10 PT11) 0 1e-6)
;;计算点位，尝试选择对象
(setq PT1 (list (+ (car PT10) 225)
(+ (cadr PT10) 23)
)
PT2 (list (+ (car PT10) 406)
(+ (cadr PT10) 12)
)
)
(setq SS1 (ssget "c" PT1 PT2))
;;如果有对象，就删除之
(princ (strcat "\r正在删除第"
(itoa N)
"张图纸"
)
)
(setq N (1+ N))
(command "._erase" SS1 "") ;_ 永远返回 nil
)
(setq I (1+ I))
) ;_结束repeat
) ;_结束if
;;
(command "._undo" "_end")
(princ)
)

(defun C:TT (/ SS N I ENT PT10 PT11 PT1 PT2 SS1) 
    ;; 
    (setvar "cmdecho" 0) 
    (command "._undo" "_begin") 
 
    (setq N 0 
          I 0 
    ) 
 
    ;;核心 
    (if        (or (setq SS (ssget "I" '((0 . "LINE")))) 
            (setq SS (ssget '((0 . "LINE")))) 
        ) 
        (repeat        (sslength SS) 
            (setq ENT  (entget (ssname SS I)) 
                  PT10 (cdr (assoc 10 ENT)) 
                  PT11 (cdr (assoc 11 ENT)) 
            ) 
            (and 
                ;;对比距离 
                (equal (distance PT10 PT11) 420 1e-6) 
                (if (< (car PT11) (car PT10)) ;关键一步。 
                    (setq TMP  PT10        ;交换坐标并非为了对比角度方便， 
                          PT10 PT11        ;重要的是后续计算的需要。 
                          PT11 TMP 
                    ) 
                ) 
                ;;对比角度 
                (equal (angle PT10 PT11) 0 1e-6) 
 
                ;;计算点位，尝试选择对象 
                (setq PT1 (list        (+ (car PT10) 225) 
                                (+ (cadr PT10) 23) 
                          ) 
                      PT2 (list        (+ (car PT10) 406) 
                                (+ (cadr PT10) 12) 
                          ) 
                ) 
                (setq SS1 (ssget "c" PT1 PT2)) 
                ;;如果有对象，就删除之 
                (princ (strcat "\r正在删除第" 
                               (itoa N) 
                               "张图纸" 
                       ) 
                ) 
                (setq N (1+ N)) 
                (command "._erase" SS1 "") ;_ 永远返回 nil 
            ) 
            (setq I (1+ I)) 
        ) ;_结束repeat 
    ) ;_结束if 
 
    ;; 
    (command "._undo" "_end") 
    (princ) 
)

theradish · 发表于 2008-12-10 13:09:02

干嘛呢。。。都来凑热闹

逐月飞鸿 · 发表于 2008-12-10 13:54:43

谢谢zm184

账号		自动登录	找回密码
密码			立即注册

[LISP程序]：批量删除程序的一个莫名瑕疵，请高手指点

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子