xj6019 发表于 2019-12-12 08:25:30

属性块递增复制的问题

本帖最后由 xj6019 于 2019-12-24 15:04 编辑



这是领导的代码网址
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=66334&page=4#pid352945
在35楼

很实用的功能 但是我的电脑运行不了啊   问问cad2015运行35楼的代码为什么不能递增复制呀谁帮忙看看，高版本不支持吗？

(DEFUN C:ADD1 ()
(SETVAR "CMDECHO" 0)
(IF (AND (SETQ S1 (CAR (ENTSEL "\nSelect Block with Attrib 选择带属性图块 :")))
          (SETQ ENT (ENTGET S1))
    (= (CDR (ASSOC 0 ENT)) "INSERT")
    (= (CDR (ASSOC 66 ENT)) 1)
) (PROGN
(COMMAND ".UNDO" "BE")
(SETQ PT0 (CDR (ASSOC 10 ENT)) N nil M nil)
(WHILE (SETQ PT1 (GETPOINT PT0 "\nInsert Point 插入点 :"))
   (COMMAND ".COPY" S1 "" PT0 PT1)
   (SETQ ENT1 (ENTGET(ENTLAST)) ENT2 ENT1)
   (WHILE (= (CDR(ASSOC 0 (SETQ ENT2 (ENTGET(ENTNEXT(CDR(ASSOC -1 ENT2))))))) "ATTRIB")
    (IF (= (CDR(ASSOC 2 ENT2)) "KKS_CODE") (PROGN
   (SETQ TXTF (CDR(ASSOC 1 ENT2)) TXTA "" I 1 SL (STRLEN TXTF))
   (WHILE (AND (> (SETQ TA (SUBSTR TXTF I 1)) "9") (< TA "0") (< I SL))
      (SETQ TXTA (STRCAT TXTA TA) I (1+ I))
   )
   (IF (<= I SL) (PROGN
      (SETQ N (1+ (IF N N (ATOI (SUBSTR TXTF I))))
               TXTF (STRCAT TA (IF (< N 10) "00" (IF (< N 100) "0" "")) (ITOA N))
               ENT1 (SUBST (CONS 1 TXTF) (ASSOC 1 ENT2) ENT2))
      (ENTMOD ENT2)
      (ENTMOD ENT1)
      (ENTUPD (ENTLAST))
   ))
    ))
    (IF (= (CDR(ASSOC 2 ENT2)) "SNA") (PROGN
   (SETQ TXTF (CDR(ASSOC 1 ENT2)) TXTA "" I 1 SL (STRLEN TXTF))
   (WHILE (AND (> (SETQ TA (SUBSTR TXTF I 1)) "9") (< TA "0") (< I SL))
      (SETQ TXTA (STRCAT TXTA TA) I (1+ I))
   )
   (IF (<= I SL) (PROGN
      (SETQ M (1+ (IF M M (ATOI (SUBSTR TXTF I))))
               TXTF (STRCAT (SUBSTR TXTF 1 2) (IF (< M 10) "00" (IF (< M 100) "0" "")) (ITOA M))
               ENT1 (SUBST (CONS 1 TXTF) (ASSOC 1 ENT2) ENT2))
      (ENTMOD ENT2)
      (ENTMOD ENT1)
      (ENTUPD (ENTLAST))
   ))
    ))
    (IF (ASSOC 60 ENT2) (PROGN
   (SETQ ENT2 (SUBST '(60 . 0) (ASSOC 60 ENT2) ENT2))
   (ENTMOD ENT2)
   (ENTMOD ENT1)
   (ENTUPD (ENTLAST))
    ))
   )
)
(COMMAND ".UNDO" "E")
))
(SETVAR "CMDECHO" 1)
(PRINC)
)

飒路紫 发表于 2019-12-13 10:41:52

这并不是一个通用程序，请看好这两句：
(IF (= (CDR(ASSOC 2 ENT2)) "KKS_CODE")
(IF (= (CDR(ASSOC 2 ENT2)) "SNA")
要么改代码，要么改你属性块的标记为"KKS_CODE"/"SNA"。
而且，每个编号只取一位文字，也不一定满足你。
多数情况下，都不是CAD的锅，应该从程序本身找问题。

xj6019 发表于 2019-12-13 12:35:45

本帖最后由 xj6019 于 2019-12-13 12:36 编辑

飒路紫 发表于 2019-12-13 10:41
这并不是一个通用程序，请看好这两句：
(IF (= (CDR(ASSOC 2 ENT2)) "KKS_CODE")
(IF (= (CDR(ASSOC 2 E ...
您好，您看看附件的这个程序，现在只能纯数字递增复制，您可以帮忙改改，我希望实现数字递增和属性块递增，这样只用一个命令就可以了，谢谢。

飒路紫 发表于 2019-12-13 13:57:55

xj6019 发表于 2019-12-13 12:35
您好，您看看附件的这个程序，现在只能纯数字递增复制，您可以帮忙改改，我希望实现数字递增和属性块递增 ...

加：589962575，讨论方便些，没看明白

sharetow 发表于 2019-12-17 11:50:00

我的递增复制你看看是否能用
http://bbs.mjtd.com/thread-180675-1-1.html

xj6019 发表于 2019-12-17 13:50:47

sharetow 发表于 2019-12-17 11:50
我的递增复制你看看是否能用
http://bbs.mjtd.com/thread-180675-1-1.html

谢谢，注意到您的帖子了，下载后加载不上，我电脑系统的原因，不是中文系统，如果是lisp我搞一下还能试试，VLX的没法试用呢！不过谢谢回帖提醒！源码您有吗？

sharetow 发表于 2019-12-17 13:53:12

xj6019 发表于 2019-12-17 13:50
谢谢，注意到您的帖子了，下载后加载不上，我电脑系统的原因，不是中文系统，如果是lisp我搞一下还能试试 ...

这个是我昨天写的，源码就不分享了。。。

xj6019 发表于 2019-12-17 13:57:25

sharetow 发表于 2019-12-17 13:53
这个是我昨天写的，源码就不分享了。。。

嗯好的我再等等吧 谢谢！

sharetow 发表于 2019-12-19 12:56:46

有偿可以给你写一个定制的，qq：599292102

xmq1103 发表于 2020-8-21 13:12:06

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=175601&highlight=%B5%DD%D4%F6%B8%B4%D6%C6
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=181806&highlight=%B5%DD%D4%F6%B8%B4%D6%C6
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=180299&highlight=%B5%DD%D4%F6%B8%B4%D6%C6
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=108502&highlight=%B5%DD%D4%F6%B8%B4%D6%C6
页: [1] 2
查看完整版本: 属性块递增复制的问题