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

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › [求助]：请求帮助！
返回列表 发新帖
查看: 648|回复: 5

[求助] [求助]：请求帮助！

[复制链接]
cssanhui
发表于 2003-1-9 11:20:22 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

×
看是否对你有用，同时也起抛砖引玉的作用。我已在CAD2002中试过，没问题。

  3. (defun c:Findtext(/ str layername ss ent1 el namelist newnamelist item i n loop name)
  4.   (setq layername (getstring "\n:请输入层名"))
  5. ;;此处你可修改一下，用选择实体的方式也可。
  6.   (if layername
  7.     (progn
  8.       (setq ss (ssget "x" (list (cons -4 " < AND") (cons 0 "TEXT")
  9.                                 (cons 8 layername) (cons -4 " AND > "))))      
  10.       (if ss
  11.         (progn
  12.           (setq i 0
  13.                 n (sslength ss)
  14.                 namelist nil
  15.                 ent1 nil
  16.                 )
  17.           (while (< i n)
  18.             (setq ent1 (ssname ss i))
  19.             (setq el (entget ent1))
  20.             (setq name (cdr (assoc 1 el)))
  21.             (setq namelist (append namelist (list name)))
  22.             (setq i (1+ i))
  23.             )
  24.           (setq i 0
  25.                 n 0
  26.                 loop 1
  27.                 )
  28.           (while loop
  29.             (setq name (nth 0 namelist))
  30.             (setq n 0)
  31.             (foreach item namelist
  32.               (if (= item name)
  33.                 (progn                  
  34.                   (setq n (1+ n))                  
  35.                   ))
  36.               )
  37.             (setq newnamelist nil)
  38.             (foreach item namelist
  39.               (if (null (= item name))
  40.                 (setq newnamelist (append newnamelist (list item)))
  41.                 )
  42.               )
  43.             (if str
  44.               (setq str (strcat str "\n" name "=" (rtos n) "个"
  45.                                 )
  46.                     )
  47.               (setq str (strcat name "=" (rtos n) "个"
  48.                                 )
  49.                     )
  50.               )
  51.             (setq namelist nil
  52.                   namelist newnamelist
  53.                   newnamelist nil
  54.                   )
  55.             (if namelist
  56.               (setq loop 1)
  57.               (setq loop nil)
  58.               )
  59.             )
  60.           
  61.             (setq namelist nil
  62.                   oldnamelist nil
  63.                 )
  64.           (setq ss nil)
  65.           ))
  66.     ))

  68.   (princ str)
  69.   (alert str)
  70.   (princ)
  71.   )
setq, namelist, newnamelist

相关帖子

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

使用道具 举报

鼠标右键
 楼主| 发表于 2003-1-9 18:22:48 | 显示全部楼层
出现这样的提示：

命令: _appload 已成功加载 Findtext.lsp。
命令: ; 错误: 输入的列表有缺陷

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

你贴在这里的代码第6行
(setq ss (ssget "x" (list (cons -4 " (cons 8 layername) (cons -4 "AND>"))))

cons -4 "      是不是少了一个引号？ 我添加了，但是还是不能正确执行。

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

使用道具 举报

ll_j

已领礼包: 6530个

财富等级: 富甲天下
发表于 2003-1-9 20:57:47 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
最初由 鼠标右键 发布
出现这样的提示：

命令: _appload 已成功加载 Findtext.lsp。
命令: ; 错误: 输入的列表有缺陷

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

你贴在这里的代码第6行
(setq ss (ssget "x" (list (co...


在 -4 " 后面有小于号及“AND")”，论坛中小于号后面连写的字符全部不能显示。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

鼠标右键
 楼主| 发表于 2003-1-9 22:26:26 | 显示全部楼层
谢谢上面两位。现在搞定了！

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

使用道具 举报

zhynt
发表于 2003-1-9 23:57:25 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
你应该用论坛提供的〔code〕代码〔/code〕格式写就不会有这种问题了。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

haijiangl
发表于 2003-1-10 19:25:21 | 显示全部楼层
我也编了一个：

  3. (defun text_sort (ss / text0 temp i tlist n ssl text1 test)

  5.         (setq ssl (sslength ss))
  6.         (setq i ssl)

  8.         (setq text0 (ssname ss 0))
  9.         (setq text0 (cdr (assoc 1 (entget text0))))
  10.         (setq tlist '())
  11.         (setq tlist (cons text0 tlist))

  13.         (while        (> i 1)
  14.                 (setq text1 (ssname ss (setq i (1- i))))
  15.                 (setq text1 (cdr (assoc 1 (entget text1))))
  16.                 (setq n (length tlist))
  17.                 (setq test n)
  18.                 (while        (> n 0)
  19.                         (setq n (1- n))
  20.                         (setq temp (nth n tlist))
  21.                         (if        (= text1 temp)
  22.                                 (setq test (1- test))
  23.                         )
  24.                 )
  25.                 (if        (= test (length tlist))
  26.                         (setq tlist (cons text1 tlist))
  27.                 )
  28.         )
  29.         (setq tlist tlist)
  30. )

  32. (defun c:nn (/ ss ssl e tlist tll text0 text1)
  33.        
  34.         (princ "\n请选取要统计的文字:")
  35.         (setq ss (ssget '((0 . "text"))))
  36.         (setq tlist (text_sort ss))       
  37.         (princ "\n所选文字中共有:")
  38.         (setq tll (length tlist))
  39.         (while         (> tll 0)
  40.                 (setq tll (1- tll))
  41.                 (setq text0 (nth tll tlist))
  42.                 (setq e 0)
  43.                 (setq ssl (sslength ss))
  44.                 (while         (> ssl 0)
  45.                         (setq text1 (ssname ss (setq ssl (1- ssl))))
  46.                         (setq text1 (cdr (assoc 1 (entget text1))))
  47.                         (if        (= text1 text0)
  48.                                 (setq e (1+ e))
  49.                         )
  50.                 )
  51.                 (princ"\n")
  52.                 (princ text0)
  53.                 (princ "----")
  54.                 (princ e)
  55.                 (princ "个")
  56.         )
  57.         (princ)
  58. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-5-14 19:35 , Processed in 0.417070 second(s), 42 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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