明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2618|回复: 10

[讨论] 快速建块,仍然有BUG

[复制链接]
发表于 2015-9-25 16:52 | 显示全部楼层 |阅读模式
本帖最后由 菜卷鱼 于 2015-11-4 22:20 编辑

BUG太多了,能力不足,搞不定,还需要进一步学习,以下代码仅供参考,、使用的话导致CAD死机甚至电脑死机自己负责啊
  1. ;;;;快速建块,花了两天时间,还是半成品。
  2. ;;;;建属性块时可能会出错,还可能有N多BUG
  3. ;;;;希望有人出手优化一下
  4. ;;;;建普通块是没问题的

  5. (defun attblock (objs / obj info )
  6.   (setq info (entget objs))
  7.   (entmake  (infodel info '(-1 330 5 )))
  8.   (setq obj (entnext objs))
  9.   (setq info (entget obj))
  10.   (while
  11.   (equal '(0 . "ATTRIB") ( assoc 0 info))
  12.   (entmake (infodel info '(-1 330 5 )))
  13.   (setq obj (entnext obj))
  14.   (setq info (entget obj)))
  15.   (entmake (list
  16.     '(0 . "SEQEND")
  17.     '(100 . "AcDbEntity")
  18.     '(67 . 0)
  19.     '(8 . "0")
  20.       )
  21.    )
  22. )
  23. (defun infodel (elist num)
  24.    (last  (mapcar '(lambda(x)  
  25.        (setq elist(vl-remove(assoc x elist)elist))
  26.        )
  27.       num
  28.     )
  29.   )
  30. )
  31. (defun ribdef ( info / elist)
  32.   (setq elist info
  33.         elist (subst '(0 . "ATTRIB")  '(0 . "ATTDEF")elist)
  34.         elist (subst '(100 . "AcDbAttribute")  '(100 . "AcDbAttributeDefinition") elist))
  35.   (last (mapcar '(lambda(x)  
  36.        (setq elist(vl-remove(assoc x elist)elist))
  37.        )
  38.     '(-1 330 5 3 410 )
  39.     )
  40.   )
  41. )
  42. (defun UndoBe ()   ;;;;; undo begin
  43.     (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
  44. )

  45. (defun UndoE ()   ;;;;; undo end
  46.     (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
  47. )

  48. (DEFUN C:Qq  ( /  *error* ss pt nn i ssattdef  info )
  49. (princ "Quick Block")
  50. (defun *error* (s)
  51. (if (/= s "取消")(undoe))
  52. )
  53.   (setq        ss (ssget)
  54.         nn (rtos(getvar 'cdate) 2 8)
  55.         pt (getvar 'viewctr)
  56.         ssattdef (ssadd))
  57.   (UndoBe)
  58.   (entmake (list
  59.     '(0 . "BLOCK")
  60.     '(100 . "AcDbEntity")
  61.     '(67 . 0)
  62.     '(8 . "0")
  63.     '(100 . "AcDbBlockBegin")
  64.     '(70 . 2)
  65.     '(1 . "")
  66.     (cons 10 pt)
  67.     (cons 2 nn)
  68.       )
  69.     )
  70.   (repeat (setq i (sslength ss))
  71.   (setq obj (ssname ss (setq i (1- i)))
  72.         info (entget obj))
  73. (cond
  74. ((equal '(0 . "ATTDEF") ( assoc 0 info))
  75.           (setq ssattdef (ssadd obj ssattdef)) (entmake (infodel info '(-1 330 5 410)) ) )
  76. ((equal '(66 . 1)
  77.           ( assoc 66 info)) (attblock obj))
  78. (T       (entmake (infodel info '(-1 330 5 410)  )) )
  79. )  ;;;end cond
  80. )  ;;;end repeat
  81. (entmake (list
  82.     '(0 . "ENDBLK")
  83.     '(100 . "AcDbEntity")
  84.     '(100 . "AcDbBlockEnd")
  85.      )
  86. )
  87.   (entupd (tblobjname "Block" nn))
  88. (if(zerop (sslength ssattdef))
  89.   (entmake (list '(0 . "insert") (cons 2 nn) (cons 10 pt)))
  90.   (progn
  91.   (entmake (list '(0 . "insert") (cons 2 nn) (cons 10 pt) '(66 . 1)))
  92.   (repeat  (setq i (sslength ssattdef))
  93.   (entmake (ribdef(entget (ssname ssattdef (setq i (1- i))))))
  94.          )   ;;;end repeat   
  95. ))  ;;;end progn if
  96.   (entmake '((0 . "SEQEND")))
  97.   (repeat (setq i (sslength ss))
  98.     (entdel (ssname ss (setq i (1- i)))))
  99.   (UndoE)
  100.   (princ (strcat "\nCreated Block " nn))
  101.   (PRIN1))
  102. (prin1)

  103. ;;;;

"觉得好,就打赏"
还没有人打赏,支持一下
 楼主| 发表于 2015-9-26 22:58 | 显示全部楼层
本帖最后由 菜卷鱼 于 2015-11-4 22:21 编辑

把没有子图元的图元建成块应该没问题的,其它的复杂点的块问题搞不定
发表于 2015-9-26 23:18 | 显示全部楼层
菜卷鱼 发表于 2015-9-26 22:58
其实我已经搞出没BUG的了,看没人回帖,就不发了

呵呵,可能大家都过节去了!  不要那么辛苦 ,节日要多放松放松
另外论坛快速建块的贴子蛮多的,以时间做块名, 形心做基点,等等,
你说有N多BUG, 具体是哪些?也没说清楚,高手们也不好怎么解答,
发表于 2015-9-28 07:47 | 显示全部楼层
提示: 作者被禁止或删除 内容自动屏蔽
发表于 2015-10-25 10:48 | 显示全部楼层
菜卷鱼 发表于 2015-9-26 22:58
其实我已经搞出没BUG的了,看没人回帖,就不发了

看来楼主是位高手,写程序都不用加注释,能发个没有BUG的出来共享一下不?谢谢!
发表于 2015-10-25 14:13 | 显示全部楼层
楼主功底很深厚,MARK,在慢慢研究。。。
发表于 2015-10-28 08:55 | 显示全部楼层
回帖呢,是什么快捷键?
发表于 2015-11-4 15:22 | 显示全部楼层
菜卷鱼 发表于 2015-9-26 22:58
其实我已经搞出没BUG的了,看没人回帖,就不发了

选择对象:  ; 错误: *error* 函数中出错无函数定义: VLAX-GET-ACAD-OBJECT
发表于 2015-11-4 15:23 | 显示全部楼层
不能用啊,楼主
发表于 2015-11-4 21:17 | 显示全部楼层
C:\asd.gif
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-29 05:01 , Processed in 0.181404 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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