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

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › [LISP函数]：一段LSP，有点问题，各位帮助看看调一下 ...
返回列表 发新帖
查看: 549|回复: 6

[LISP函数]：一段LSP，有点问题，各位帮助看看调一下

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

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

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

×
程序是长老［陌生人］的，一直找不到他老人家；加了点东西，就调不出来，各位看看：
;|(sj)= 选用;----------------------------------------------------------------陌生人.2004.1
;v1.1 2004.1.对mtext的bug修正。消除重复符号;支持-.5写法,排除"写.法" ".." "+-";
功能：对选集中文本进行所有数字计算,支持一个text,mtext中有多个数字字符串,支持字符串中

小数,负数:
返回: 有数字，数字相加后写文本，并返回求和数值(非字符串).无有效数字返回nil.
|;
(defun c:sj ( / ss filter mspace n e str asclst strs add pt txt txth)
  (defun *error* (msg) (if ss (x_draw ss 4)) (setq *error* oerr))
  (princ "\n选用－－－－－－－－－－－－－－－－－－－－－－－陌生人.2004.1")
  (princ "\n选择要计算的文本(支持*TEXT选择集):")
  (setq oerr *error*
        ss (ssget '((0 . "*TEXT")))
        filter "0123456789.-+"
        mspace (vla-get-modelspace(vla-get-activedocument (vlax-get-acad-object)))
        str nil strs nil)
  (if ss
    (repeat (setq n (sslength ss))
      (x_draw ss 3)
      (setq n (1- n)
            e (ssname ss n)
            str (vla-get-textstring(vlax-ename->vla-object e))
            strs (strcat (if strs strs " ") (x_txt2 str) " ")) ;;排除mtext bug.v1.1-2004.1
      )
    )
  (if (and ss (/= "" strs))
    (progn
      (setq add (eval (read (strcat "(+ " strs ")"))))
   (setq kg1 add)
  (if (< kg1 32)(setq kg11 32))
  (if (<= 32 kg1 40)(setq kg11 50))
  (if (< 40 kg1 50)(setq kg11 63))
  (if (<= 50 kg1 63)(setq kg11 80))
  (if (< 63 kg1 80)(setq kg11 100))
  (if (<= 80 kg1 100)(setq kg11 125))
  (if (< 100 kg1 125)(setq kg11 125))
  (if (<= 125 kg1 160)(setq kg11 200))
  (if (< 160 kg1 200)(setq kg11 200))   
  (if (<= 200 kg1 250)(setq kg11 320))
  (if (< 250 kg1 320)(setq kg11 320))
  (if (<= 300 kg1 400)(setq kg11 400))
  (if (< 400 kg1 500)(setq kg11 500))   
  (if (<= 500 kg1 630)(setq kg11 630))
  (if (< 630 kg1 )(setq kg11 n!!!))

(setq kg11 (rtos kg11 2 0))
(setq po (getpoint "input point----:"))
(command "text" po  ""  "" (strcat "选用""" kg11 "A"))
)
            )
          (progn (if ss (x_draw ss 4))(xtcal))  ;多次<重新计算>可以作为一个简易统计查看器.
      )
    )
    (progn (princ "\n!空选集或文本中无有效数字!\n") nil)
  )
)


;;
(defun x_draw (ss key / n e)
  (if (= 'PICKSET (type ss))
    (repeat (setq n (sslength ss))
      (setq n (1- n)
            e (ssname ss n))
      (redraw e key)
    )
  )
)
;;
(defun x_txt2 (str / i key1 key2 str1)
(setq i 1 key2 nil)
(repeat (strlen str)
(cond
((= "{\\f" (substr str i 3)) (setq i (+ 3 i) key1 1 key2 1))
((and key1 (= "}" (substr str i 1))) (setq key1 nil key2 nil))
((and key1 (= ";" (substr str i 1))) (setq key2 nil))
((not key2)
(setq st (substr str i 1)
str1 (strcat (if (not str1) "" str1)
(cond
((= "." st)(if (wcmatch (substr str (1+ i) 1) "#") st " "))
((member st '("+" "-")) (if (wcmatch (substr str (1+ i) 1) "#,'.") st " "))
(T (if (wcmatch filter (strcat "*" st "*")) st " "))
)
))
)
)
(setq i (1+ i))
)
(setq str str1)
)

－－－－－－－－－－－》Error: 输入中含有多余的闭括号
setq, kg11, kg1

相关帖子

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

使用道具 举报

zxq0220

已领礼包: 11304个

财富等级: 富甲天下
发表于 2005-3-3 16:03:18 | 显示全部楼层
不清楚原程序结构，只能粗略判断，第一个函数多右括弧。更改如下：

  3. (defun c:sj ( / ss filter mspace n e str asclst strs add pt txt txth)
  4. (defun *error* (msg) (if ss (x_draw ss 4)) (setq *error* oerr))
  5. (princ "\n选用－－－－－－－－－－－－－－－－－－－－－－－陌生人.2004.1")
  6. (princ "\n选择要计算的文本(支持*TEXT选择集):")
  7. (setq oerr *error*
  8.       ss (ssget '((0 . "*TEXT")))
  9.       filter "0123456789.-+"
  10.       mspace (vla-get-modelspace(vla-get-activedocument (vlax-get-acad-object)))
  11.       str nil strs nil)
  12. (if ss
  13. (repeat (setq n (sslength ss))
  14.   (x_draw ss 3)
  15.   (setq n (1- n)
  16.         e (ssname ss n)
  17.         str (vla-get-textstring(vlax-ename->vla-object e))
  18.         strs (strcat (if strs strs " ") (x_txt2 str) " ")) ;;排除mtext bug.v1.1-2004.1
  19.   )
  20.   (if (and ss (/= "" strs)) (progn
  21.    (setq add (eval (read (strcat "(+ " strs ")"))))
  22.    (setq kg1 add)
  23.    (if (< kg1 32)(setq kg11 32))
  24.    (if (<= 32 kg1 40)(setq kg11 50))
  25.    (if (< 40 kg1 50)(setq kg11 63))
  26.    (if (<= 50 kg1 63)(setq kg11 80))
  27.    (if (< 63 kg1 80)(setq kg11 100))
  28.    (if (<= 80 kg1 100)(setq kg11 125))
  29.    (if (< 100 kg1 125)(setq kg11 125))
  30.    (if (<= 125 kg1 160)(setq kg11 200))
  31.    (if (< 160 kg1 200)(setq kg11 200))
  32.    (if (<= 200 kg1 250)(setq kg11 320))
  33.    (if (< 250 kg1 320)(setq kg11 320))
  34.    (if (<= 300 kg1 400)(setq kg11 400))
  35.    (if (< 400 kg1 500)(setq kg11 500))
  36.    (if (<= 500 kg1 630)(setq kg11 630))
  37.    (if (< 630 kg1)(setq kg11 n!!!))

  39.    (setq kg11 (rtos kg11 2 0))
  40.    (setq po (getpoint "input point----:"))
  41.    (command "text" po "" "" (strcat "选用""" kg11 "A"))
  42.   ) (progn
  43.    (if ss (x_draw ss 4))
  44.    (xtcal)
  45.   ) ;多次<重新计算>可以作为一个简易统计查看器.
  46.   )
  47. )
  48. (progn (princ "\n!空选集或文本中无有效数字!\n")
  49. )
  50. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

dhxf
 楼主| 发表于 2005-3-3 16:52:02 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
谢谢关注；
还是同样ERROR；
一波为平一波又起：
(defun c:dvv ( / ss filter mspace n e str asclst strs add pt txt txth kg1 kg11)
  (defun *error* (msg) (if ss (x_draw ss 4)) (setq *error* oerr))
  (princ "\n文本数字求和－－－－－－－－－－－－－－－－－－－－－－－陌生人.2004.1")
  (princ "\n选择要计算的文本(支持*TEXT选择集):")
  (setq oerr *error*
        ss (ssget '((0 . "*TEXT")))
        filter "0123456789.-+"
        mspace (vla-get-modelspace(vla-get-activedocument (vlax-get-acad-object)))
        str nil strs nil)
  (if ss
    (repeat (setq n (sslength ss))
      (x_draw ss 3)
      (setq n (1- n)
            e (ssname ss n)
            str (vla-get-textstring(vlax-ename->vla-object e))
            strs (strcat (if strs strs " ") (x_txt2 str) " ")) ;;排除mtext bug.v1.1-2004.1
      )
    )
  (if (and ss (/= "" strs))
    (progn
      (setq add (eval (read (strcat "(+ " strs ")"))))

     
(setq kg1  add)
  (if (<=  43)(setq kg11 "VV-5x6-SC25"))
  (if (< 43 kg1 60)(setq kg11 "VV-5x10-SC25"))
  (if (<= 60 kg1 75)(setq kg11 "VV-3x16+2x10-SC32"))
  (if (< 75 kg1 100)(setq kg11 "VV-3x25+2x16-SC40"))

(setq po (getpoint "input point----:"))
(command "text" po ""  ""  kg11))
)
            )
          (progn (if ss (x_draw ss 4))(xtcal))  ;多次<重新计算>可以作为一个简易统计查看器.
      )


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

使用道具 举报

zxq0220

已领礼包: 11304个

财富等级: 富甲天下
发表于 2005-3-3 17:49:58 | 显示全部楼层
dhxf ：您写程序时注意一下书写格式就可以很快找到错误。

  3. (defun c:dvv ( / ss filter mspace n e str asclst strs add pt txt txth kg1 kg11)
  4. (defun *error* (msg) (if ss (x_draw ss 4)) (setq *error* oerr))
  5. (princ "\n文本数字求和－－－－－－－－－－－－－－－－－－－－－－－陌生人.2004.1")
  6. (princ "\n选择要计算的文本(支持*TEXT选择集):")
  7. (setq oerr *error*
  8.       ss (ssget '((0 . "*TEXT")))
  9.       filter "0123456789.-+"
  10.       mspace (vla-get-modelspace(vla-get-activedocument (vlax-get-acad-object)))
  11.       str nil strs nil)
  12. (if ss
  13. (repeat (setq n (sslength ss))
  14.   (x_draw ss 3)
  15.   (setq n (1- n)
  16.         e (ssname ss n)
  17.         str (vla-get-textstring(vlax-ename->vla-object e))
  18.         strs (strcat (if strs strs " ") (x_txt2 str) " ")
  19.    ) ;;排除mtext bug.v1.1-2004.1
  20.   (if (and ss (/= "" strs)) (progn
  21.    (setq add (eval (read (strcat "(+ " strs ")"))))

  23.    (setq kg1 add)
  24.    (if (<= 43)(setq kg11 "VV-5x6-SC25"))
  25.    (if (< 43 kg1 60)(setq kg11 "VV-5x10-SC25"))
  26.    (if (<= 60 kg1 75)(setq kg11 "VV-3x16+2x10-SC32"))
  27.    (if (< 75 kg1 100)(setq kg11 "VV-3x25+2x16-SC40"))

  29.    (setq po (getpoint "input point----:"))
  30.    (command "text" po "" "" kg11)
  31.   ))
  32. )
  33. (progn
  34.   (if ss (x_draw ss 4))
  35.   (xtcal)
  36. ) ;多次<重新计算>可以作为一个简易统计查看器.
  37. )
  38. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

dhxf
 楼主| 发表于 2005-3-3 18:27:46 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
特别感谢zxq0220;说不感谢是假的；我折腾这几段好几天了；
dvv问题解决；不过还有一段；
(defun c:zvv ( / ss filter mspace n e str asclst strs add pp txt txth kg2 kg12)
(defun *error* (msg) (if ss (x_draw ss 4)) (setq *error* oerr))
(princ "\n文本数字求和－－－－－－－－－－－－－－－－－－－－－－－陌生人.2004.1")
(princ "\n选择要计算的文本(支持*TEXT选择集):")
(setq oerr *error*
      ss (ssget '((0 . "*TEXT")))
      filter "0123456789.-+"
      mspace (vla-get-modelspace(vla-get-activedocument (vlax-get-acad-object)))
      str nil strs nil)
(if ss
(repeat (setq n (sslength ss))
  (x_draw ss 3)
  (setq n (1- n)
        e (ssname ss n)
        str (vla-get-textstring(vlax-ename->vla-object e))
        strs (strcat (if strs strs " ") (x_txt2 str) " ")
   ) ;;排除mtext bug.v1.1-2004.1
  (if (and ss (/= "" strs)) (progn
   (setq add (eval (read (strcat "(+ " strs ")"))))

   (setq kg2 (* 1.4 add))
   (if (<=kg2  43)(setq kg12 "VV-5x6-SC25"))
  (if (< 43 kg2 60)(setq kg12 "VV-5x10-SC25"))
  (if (<= 60 kg2 75)(setq kg12 "VV-4x16+10-SC32"))
  (if (< 75 kg2 100)(setq kg12 "VV-4x25+16-SC40"))


   (setq pp (getpoint "input point----:"))
   (command "text" pp "" "" kg12)
  ))
)
(progn
  (if ss (x_draw ss 4))
  (xtcal)
) ;多次<重新计算>可以作为一个简易统计查看器.
)
)

这一段是按照正确格式写的；也没ERROR提示；
和DVV同时加载后，DVV运行，ZVV程序不运行；
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

zxq0220

已领礼包: 11304个

财富等级: 富甲天下
发表于 2005-3-4 17:19:14 | 显示全部楼层
程序ZVV与DVV结构基本相同，维一不同的是：(setq kg2 (* 1.4 add))
楼主可以将变量add显示出看一看是否能够乘以1.4。我机器上只装了R14，无法运行您的程序。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

dhxf
 楼主| 发表于 2005-3-4 17:45:08 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
!add, nil
(setq kg2 add)
出现同样问题;
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2025-9-28 00:40 , Processed in 0.456324 second(s), 44 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

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