设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › [求助]：帮我看看这个程序问题出在哪?
返回列表 发新帖
查看: 629|回复: 3

[求助] [求助]：帮我看看这个程序问题出在哪?

[复制链接]
啵浪鼓
发表于 2005-3-31 00:37:33 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

×
(defun c:dm( / s i si)
(princ "   Delete 'TEXT MTEXT DIMENSION LEADER TOLERANCE'...")
(command "undo" "be")
           (setvar "cmdecho" 0)
           (setq s(ssget '((0 . "TEXT,MTEXT,DIMENSION,LEADER,TOLERANCE"))))
           (setq i1 0 i2 0 i3 0 i4 0 i5 0)
           (while s
                 (setq i 0)
                 (while (<= i (- (sslength s) 1))
                        (setq si(ssname s i))
                        (if (= "TEXT" (cdr (assoc 0 (entget si))))
                            (setq i1 (+ 1 i1))
                            (command "erase" si "" )
                        )
                        (if (= "MTEXT" (cdr (assoc 0 (entget si))))
                            (setq i2 (+ 1 i2))
                            (command "erase" si "" )
                        )
                        (if (= "DIMENSION" (cdr (assoc 0 (entget si))))
                            (setq i3 (+ 1 i3))
                            (command "erase" si "" )
                        )
                        (if (= "LEADER" (cdr (assoc 0 (entget si))))
                            (setq i4 (+ 1 i4))
                            (command "erase" si "" )
                        )
                        (if (= "TOLERANCE" (cdr (assoc 0 (entget si))))
                            (setq i5 (+ 1 i5))
                            (command "erase" si "" )
                        )
                        (setq i (+ i 1)
                    )                       
                 )
                       (setq s nil)
           )
  (setq notes(Strcat " 删除单行文本数量 " (rtos i1 2 0) " ?删除多行文本数量 " (rtos i2 2 0) "  删除标注数量 " (rtos i3 2 0) " 删除引线数量 " (rtos i4 2 0) " 删除公差数量 " (rtos i5 2 0) " "))
              (print notes)
(command "undo" "e")
(princ))


上面的程序为删除单行/多行文字,标注,公差,引线等并计算删除的数量,问题出在:
1,在CAD2002版内,按U键不能退回到最初状态,在CAD2006版内却可以,不知何故?
2,不能统计出各单位数量,只算出来单行文本的数量,其它都为0
命令执行完毕如下:
Command: dm
   Delete 'TEXT MTEXT DIMENSION LEADER TOLERANCE'...
Select objects: Specify opposite corner: 213 found
Select objects:
" 删除单行文本数量 89 ?删除多行文本数量 0  删除标注数量 0 删除引线数量 0 删除公差数量 0 "
数量, 删除, setq

相关帖子

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

ljpnb
发表于 2005-3-31 07:58:00 | 显示全部楼层
其实全被这句给删除了
(if (= "TEXT" (cdr (assoc 0 (entget si))))
(setq i1 (+ 1 i1))
(command "erase" si "" )
)

不能用if语句，应该用cond函数
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

david96007
发表于 2005-3-31 08:02:23 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略



  5. (defun c:dm (/ s i si)
  6.   (princ " Delete 'TEXT MTEXT DIMENSION LEADER TOLERANCE'..."
  7.   )
  8.   (command "undo" "be")
  9.   (setvar "cmdecho" 0)
  10.   (setq        s
  11.          (ssget        '((0 . "TEXT,MTEXT,DIMENSION,LEADER,TOLERANCE"))
  12.          )
  13.   )
  14.   (setq        i1 0
  15.         i2 0
  16.         i3 0
  17.         i4 0
  18.         i5 0
  19.   )
  20.   (while s
  21.     (setq i 0)
  22.     (while (<= i (- (sslength s) 1))
  23.       (setq si (ssname s i))
  24.       (if (= "TEXT" (cdr (assoc 0 (entget si))))
  25.         (progn (setq i1 (+ 1 i1))
  26.                (command "erase" si "")
  27.         )
  28.       )
  29.       (if (= "MTEXT" (cdr (assoc 0 (entget si))))
  30.         (progn (setq i2 (+ 1 i2))
  31.                (command "erase" si "")
  32.         )
  33.       )
  34.       (if (= "DIMENSION" (cdr (assoc 0 (entget si))))
  35.         (progn (setq i3 (+ 1 i3))
  36.                (command "erase" si "")
  37.         )
  38.       )
  39.       (if (= "LEADER" (cdr (assoc 0 (entget si))))
  40.         (progn (setq i4 (+ 1 i4))
  41.                (command "erase" si "")
  42.         )
  43.       )
  44.       (if (= "TOLERANCE" (cdr (assoc 0 (entget si))))
  45.         (progn (setq i5 (+ 1 i5))
  46.                (command "erase" si "")
  47.         )
  48.       )
  49.       (setq i (+ i 1)
  50.       )
  51.     )
  52.     (setq s nil)
  53.   )
  54.   (setq        notes (Strcat " 删除单行文本数量 "
  55.                       (rtos i1 2 0)
  56.                       " ?删除多行文本数量 "
  57.                       (rtos i2 2 0)
  58.                       " 删除标注数量 "
  59.                       (rtos i3 2 0)
  60.                       " 删除引线数量 "
  61.                       (rtos i4 2 0)
  62.                       " 删除公差数量 "
  63.                       (rtos i5 2 0)
  64.                       " "
  65.               )
  66.   )
  67.   (print notes)
  68.   (command "undo" "e")
  69.   (princ)
  70. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

啵浪鼓
 楼主| 发表于 2005-3-31 12:40:00 | 显示全部楼层
谢谢二三楼的朋友,程序可行~~~
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2025-9-28 00:37 , Processed in 0.166462 second(s), 36 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

快速回复 返回顶部 返回列表