属性块递增复制的问题

xj6019

这是领导的代码网址 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) )

飒路紫

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

xj6019

飒路紫 发表于 2019-12-13 10:41
这并不是一个通用程序，请看好这两句：
(IF (= (CDR(ASSOC 2 ENT2)) "KKS_CODE")
(IF (= (CDR(ASSOC 2 E ...

您好，您看看附件的这个程序，现在只能纯数字递增复制，您可以帮忙改改，我希望实现数字递增和属性块递增，这样只用一个命令就可以了，谢谢。

飒路紫

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

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

sharetow

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

xj6019

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

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

sharetow

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

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

xj6019

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

嗯  好的  我再等等吧 谢谢！

sharetow

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

xmq1103

http://bbs.mjtd.com/forum.php?mo ... D%D4%F6%B8%B4%D6%C6
http://bbs.mjtd.com/forum.php?mo ... D%D4%F6%B8%B4%D6%C6
http://bbs.mjtd.com/forum.php?mo ... D%D4%F6%B8%B4%D6%C6
http://bbs.mjtd.com/forum.php?mo ... D%D4%F6%B8%B4%D6%C6