设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › [求助]哪位高手帮忙看看这个程序错在了哪里？
12下一页
返回列表 发新帖
查看: 2222|回复: 14

[求助]哪位高手帮忙看看这个程序错在了哪里？

    [复制链接]
userzhl
发表于 2009-5-23 11:55:00 | 显示全部楼层 |阅读模式
;有很多这样的属性块，提示有“标高_1:10”、“标高_1:20”“标高_1:40”“标高_1:50”“标高_1:100”“标高_1:150”“标高_1:200”。。。
;下面这个程序是选择图中符合条件的块，然后进行缩放。

(Defun c:tt (/ DATA II OS SN SS STR)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(vlax-for BLK (vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
(vlax-for X BLK
(if (and (= (vla-get-objectname X) "AcDbAttributeDefinition")
(wcmatch (setq str (vla-get-promptstring X))
"标高*"
)
)
(setq data (cons (cons (vla-get-name BLK)
(read (vl-string-subst
""
"标高_1:"
str
)
)
)
data
)
)
)
)
)
(foreach blk data
(if (setq ii -1
ss (ssget (list (cons 0 "insert") (cons 2 (car blk)))
)
)
(repeat (sslength ss)
(setq sn (ssname ss (setq ii (1+ ii))))
(command "_.Scale"
sn
""
(cdr (assoc 10 (entget sn)))
(/ 50.0 (cdr blk))
)
)
)
)
(setvar "osmode" os)
(princ)
)
;哪位高手帮忙看看这个程序错在了哪里？附件中有测试文件。

本帖子中包含更多资源

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

x
"觉得好，就打赏"
打赏
还没有人打赏，支持一下
回复

使用道具 举报

mmmmmm
发表于 2009-5-23 12:14:00 | 显示全部楼层
  3. (Defun c:tt (/ BNN DATA II OS SN SS STR)
  4.   (setq os (getvar "osmode"))
  5.   (setvar "osmode" 0)
  6.   (vlax-for BLK (vla-get-blocks
  7.     (vla-get-activedocument (vlax-get-acad-object))
  8.   )
  9.     (vlax-for X BLK
  10.       (if (and (= (vla-get-objectname X) "AcDbAttributeDefinition")
  11.         (wcmatch (setq str (vla-get-promptstring X))
  12.    "±ê¸ß*"
  13.         )
  14.    )
  15. (setq data (cons (cons (vla-get-name BLK)
  16.           (read (vl-string-subst
  17.            ""
  18.            "±ê¸ß_1:"
  19.            str
  20.          )
  21.           )
  22.     )
  23.     data
  24.      )
  25. )
  26.       )
  27.     )
  28.   )
  29.   (foreach blk data
  30.     (if (setq bnn (car blk)
  31.        bnn (if (= (substr bnn 1 1) "*")
  32.       (strcat "`" bnn)
  33.       bnn
  34.     )
  35.        ii  -1
  36.        ss  (ssget "_x"
  37.     (list (cons 0 "insert") (cons 2 bnn))
  38.     )
  39. )
  40.       (repeat (sslength ss)
  41. (setq sn (ssname ss (setq ii (1+ ii))))
  42. (command "_.Scale"
  43.    sn
  44.    ""
  45.    (cdr (assoc 10 (entget sn)))
  46.    (/ 50.0 (cdr blk))
  47. )
  48.       )
  49.     )
  50.   )
  51.   (setvar "osmode" os)
  52.   (princ)
  53. )
回复 支持 反对

使用道具 举报

userzhl
 楼主| 发表于 2009-5-23 12:51:00 | 显示全部楼层

非常感谢mmmmmm，但我想要的是：只对图中“所选择”的符合条件的块进行处理，并不是对图中“所有”符合条件的块进行处理。而且这个功能不要对图“所有块”进行判断，因为文件大一点的话就会很慢。

回复 支持 反对

使用道具 举报

mmmmmm
发表于 2009-5-23 20:49:00 | 显示全部楼层
  3. (Defun c:tt (/ BNN BNX DATA II OS SN SS STR)
  4.   (setq os (getvar "osmode"))
  5.   (setvar "osmode" 0)
  6.   (vlax-for BLK (vla-get-blocks
  7.     (vla-get-activedocument (vlax-get-acad-object))
  8.   )
  9.     (vlax-for X BLK
  10.       (if (and (= (vla-get-objectname X) "AcDbAttributeDefinition")
  11.         (wcmatch (setq str (vla-get-promptstring X))
  12.    "标高*"
  13.         )
  14.    )
  15. (setq data (cons (cons (vla-get-name BLK)
  16.           (read (vl-string-subst
  17.            ""
  18.            "标高_1:"
  19.            str
  20.          )
  21.           )
  22.     )
  23.     data
  24.      )
  25. )
  26.       )
  27.     )
  28.   )
  29.   (foreach blk data
  30.     (setq bnn (car blk)
  31.    bnn (if (= (substr bnn 1 1) "*")
  32.   (strcat "`" bnn)
  33.   bnn
  34.        )
  35.     )
  36.     (if (null bnx)
  37.       (setq bnx bnn)
  38.       (setq bnx (strcat bnx "," bnn))
  39.     )
  40.   )
  41.   (if (and (princ "\n 请选择图块 <退出>:")
  42.     (setq ss (ssget (list (cons 0 "insert") (cons 2 bnn))))
  43.     (setq ii -1)
  44.       )
  45.     (repeat (sslength ss)
  46.       (setq sn (ssname ss (setq ii (1+ ii)))
  47.      scl (cdr (assoc (cdr (assoc 2 (entget sn))) data))
  48.       )
  49.       (command "_.Scale"
  50.         sn
  51.         ""
  52.         (cdr (assoc 10 (entget sn)))
  53.         (/ 50.0 scl)
  54.       )
  55.     )
  56.   )
  57.   (setvar "osmode" os)
  58.   (princ)
  59. )
回复 支持 反对

使用道具 举报

userzhl
 楼主| 发表于 2009-5-23 21:12:00 | 显示全部楼层

文件比较大时也是比较的慢，而且图中如果没有符合条件的属性块的话会出错：

命令: tt
 请选择图块 <退出>:; 错误: ssget 列表值错误

回复 支持 反对

使用道具 举报

mmmmmm
发表于 2009-5-24 00:25:00 | 显示全部楼层

要想速度快，你需要提高硬件。

图中如果没有符合条件的属性块，就不需要运行本程序，出错也无所谓。你自己也会一点点，可以自己去修改的。

回复 支持 反对

使用道具 举报

userzhl
 楼主| 发表于 2009-5-24 08:46:00 | 显示全部楼层
本帖最后由 作者 于 2009-5-24 10:31:04 编辑

我有的是CPU酷瑞双核2.5G,内存2G,CAD2007.我这个程序是想对已有的选择集进行处理的。

(Defun c:tt ( / blk bnn bnx data ii scl sn ss ssi str)
(princ "\n 请选择图块 <退出>:")
(setq ss (ssget '((0 . "INSERT"))))
    (vlax-for BLK (vla-get-blocks
     (vla-get-activedocument (vla-get-objectname ss))
   );在此如何对已有选择对象SS进行判断呢？这里这样好像不行
     (vlax-for ss BLK
       (if (and (= (vla-get-objectname ss) "AcDbAttributeDefinition")
         (wcmatch (setq str (vla-get-promptstring ss))
    "标高*"
         )
    )
  (setq data (cons (cons (vla-get-name BLK)
           (read (vl-string-subst
            ""
            "标高_1:"
            str
          )
           )
     )
     data
      )
  )
       )
     )
   )
   (foreach blk data
     (setq bnn (car blk)
    bnn (if (= (substr bnn 1 1) "*")
   (strcat "`" bnn)
   bnn
        )
     )
     (if (null bnx)
       (setq bnx bnn)
       (setq bnx (strcat bnx "," bnn))
     )
   )
   (if (and (/= nil bnn) (setq ii -1))
(progn
(vl-cmdf "select" ss "")
(setq ssi (ssget "p" (list (cons 0 "INSERT") (cons 2 bnn))))
     (repeat (sslength ssi)
       (setq sn (ssname ssi (setq ii (1+ ii)))
      scl (cdr (assoc (cdr (assoc 2 (entget sn))) data))
       )
       (command "_.Scale"
         sn
         ""
         (cdr (assoc 10 (entget sn)))
         (/ 50.0 scl)
       )
     )
)
   )
   (princ)
)

回复 支持 反对

使用道具 举报

carrot1983
发表于 2009-5-24 09:17:00 | 显示全部楼层

Good Luck!

http://carrot1983.blog.sohu.com/116624404.html

回复 支持 反对

使用道具 举报

userzhl
 楼主| 发表于 2009-5-24 09:51:00 | 显示全部楼层

小萝卜头，你不明白我的意思，你的程序没能达到我想要的结果。

我想要的是：对已有选择对象SS进行判断呢？

回复 支持 反对

使用道具 举报

userzhl
 楼主| 发表于 2009-5-24 23:02:00 | 显示全部楼层

哪位高人出手帮忙一下，这将完成我的软件的一个阶段：

我这个程序是想对已有的选择集进行处理的。

(Defun c:tt ( / blk bnn bnx data ii scl sn ss ssi str)
(princ "\n 请选择图块 <退出>:")
(setq ss (ssget '((0 . "INSERT"))))
    (vlax-for BLK (vla-get-blocks
     (vla-get-activedocument (vla-get-objectname ss))
   );在此如何对已有选择对象SS进行判断呢？这里这样好像不行
     (vlax-for ss BLK
       (if (and (= (vla-get-objectname ss) "AcDbAttributeDefinition")
         (wcmatch (setq str (vla-get-promptstring ss))
    "标高*"
         )
    )
  (setq data (cons (cons (vla-get-name BLK)
           (read (vl-string-subst
            ""
            "标高_1:"
            str
          )
           )
     )
     data
      )
  )
       )
     )
   )
   (foreach blk data
     (setq bnn (car blk)
    bnn (if (= (substr bnn 1 1) "*")
   (strcat "`" bnn)
   bnn
        )
     )
     (if (null bnx)
       (setq bnx bnn)
       (setq bnx (strcat bnx "," bnn))
     )
   )
   (if (and (/= nil bnn) (setq ii -1))
(progn
(vl-cmdf "select" ss "")
(setq ssi (ssget "p" (list (cons 0 "INSERT") (cons 2 bnn))))
     (repeat (sslength ssi)
       (setq sn (ssname ssi (setq ii (1+ ii)))
      scl (cdr (assoc (cdr (assoc 2 (entget sn))) data))
       )
       (command "_.Scale"
         sn
         ""
         (cdr (assoc 10 (entget sn)))
         (/ 50.0 scl)
       )
     )
)
   )
   (princ)
)

回复 支持 反对

使用道具 举报

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

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-9-29 18:24 , Processed in 0.182595 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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