[求助]属性块的增量复制

etom999 · 发表于 2008-3-11 07:34

本帖最后由作者于 2008-3-18 7:06:00 编辑

文件添加

ZZXXQQ · 发表于 2008-3-24 16:06

本帖最后由作者于 2008-3-28 20:41:34 编辑

再试试。

游客，本帖隐藏的内容需要发帖数高于 5 才可浏览，你当前发帖数只有 0

xj6019 · 发表于 2019-12-11 22:48

本帖最后由 xj6019 于 2019-12-11 22:49 编辑

老帖子顶一下很实用的功能电脑运行不了啊问问cad2015运行35楼的代码为什么不能递增复制呀  谁帮忙看看，高版本不支持吗？
代码是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)
)

xj6019 · 发表于 2019-12-12 18:40

ZZXXQQ 发表于 2008-3-24 16:06
再试试。

[/post]

冒昧打扰一下，您35楼的这个代码为什么高版本cad不能运行呀，很想用一下，需要一个属性块可以递增复制的程序，谢谢了！

etom999 · 发表于 2008-3-14 07:22

ZZXXQQ大侠,能解决一下？

ZZXXQQ · 发表于 2008-3-14 16:49

为调试程序请给个样图。

etom999 · 发表于 2008-3-17 06:55

本帖最后由作者于 2008-3-17 6:56:51 编辑

块ABB-CL-SG中，
SNA,XR_FUNCTION是要复制增加的属性ABB-CL-SG.rar

ZZXXQQ · 发表于 2008-3-17 07:58

无法下载!

etom999 · 发表于 2008-3-18 07:04

添加文件

etom999 · 发表于 2008-3-18 07:31

DWG文件怎么上传

ZZXXQQ · 发表于 2008-3-18 08:20

可以直接上传。如文件太大，也可以压缩后上传。先点[浏览]钮选择文件后点[上传]钮，上传完毕后再点[回复]。

etom999 · 发表于 2008-3-18 11:58

我就是上传不上...

etom999 · 发表于 2008-3-18 12:01

How about

账号		自动登录	找回密码
密码			注册

[求助]属性块的增量复制

点评

[下载]

回复：（ZZXXQQ）可以直接上传。如文件太大，也可以压...