字段关联文字递增

水洗可口可乐

tranque 发表于 2026-1-5 12:11
你把源码喂给国内AI，描述的详细点，国内AI分分钟就给你做出来一个适配07版本的

07自身的反应器不行，适配不了

tranque

水洗可口可乐 发表于 2026-1-5 14:14
07自身的反应器不行，适配不了

问完AI了，测试得靠你自己了，我没安装07版本的ACAD

要在 AutoCAD 2007 中完美运行这段代码，我们需要解决两个核心兼容性问题：

• ObjectID 的获取方式：AutoCAD 2007 是较早的版本，不支持 GetObjectIdString 这种 64 位方法。在 2007 环境下，ObjectID 通常是一个 32 位整数，直接使用 vla-get-ObjectID 即可。
• 字段表达式（Field）的格式：旧版本的字段语法对空格和斜杠较为敏感。
• 刷新机制：2007 版本对 UPDATEFIELD 命令的支持及对象刷新机制与现代版本略有不同。
  
  

以下是适配 AutoCAD 2007 的优化版本：

1. (vl-load-com)
   
2. 
   
3. (defun c:NumLink (/ *error* js en ent vla-obj
   
4.                     str-val pt
   
5.                     obj-id field-str
   
6.                     acad-obj doc util
   
7.                     inc-val new-en)
   
8. 
   
9.   ;; 1. 错误处理
   
10.   (defun *error* (msg)
    
11.     (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*")))
    
12.       (princ (strcat "\n错误: " msg))
    
13.     )
    
14.     (if doc (vla-EndUndoMark doc))
    
15.     (setvar "CMDECHO" 1)
    
16.     (princ)
    
17.   )
    
18. 
    
19.   ;; 2. 初始化
    
20.   (setq acad-obj (vlax-get-acad-object))
    
21.   (setq doc (vla-get-ActiveDocument acad-obj))
    
22.   (setq util (vla-get-Utility doc))
    
23. 
    
24.   (vla-StartUndoMark doc)
    
25.   (setvar "CMDECHO" 0)
    
26. 
    
27.   ;; 3. 校验函数
    
28.   (defun Is-String-Numeric (str)
    
29.     (if (distof str) T nil)
    
30.   )
    
31. 
    
32.   ;; 4. 获取 ObjectID (适配 2007 32位环境)
    
33.   (defun Get-Field-ObjectID (obj)
    
34.     ;; 2007版本直接获取ObjectID即可，转换为字符串
    
35.     (vl-princ-to-string (vla-get-ObjectID obj))
    
36.   )
    
37. 
    
38.   ;; 5. 主逻辑
    
39.   (princ "\n请选择基准数字文字 (TEXT): ")
    
40. 
    
41.   (if (setq js (ssget ":S" '((0 . "TEXT"))))
    
42.     (progn
    
43.       (setq en (ssname js 0))
    
44.       (setq ent (entget en))
    
45.       (setq vla-obj (vlax-ename->vla-object en))
    
46.       (setq str-val (cdr (assoc 1 ent)))
    
47. 
    
48.       (if (Is-String-Numeric str-val)
    
49.         (progn
    
50.           (setq obj-id (Get-Field-ObjectID vla-obj))
    
51.           (setq inc-val 1)
    
52. 
    
53.           ;; 循环放置
    
54.           (while (setq pt (getpoint (strcat "\n放置位置 (当前基准 +" (itoa inc-val) ") [右键或ESC退出]: ")))
    
55. 
    
56.             ;; 构建 2007 兼容的字段表达式
    
57.             ;; 注意：2007 字段中的 ObjId 后面不一定需要额外的控制字符
    
58.             (setq field-str
    
59.               (strcat
    
60.                 "%<\\AcExpr (%<\\AcObjProp Object(%<\\_ObjId "
    
61.                 obj-id
    
62.                 ">%).TextString>% + "
    
63.                 (itoa inc-val)
    
64.                 ") \\f \"%lu2%pr0\">%"
    
65.               )
    
66.             )
    
67. 
    
68.             ;; 生成文字 (entmake 在 2007 中非常稳定)
    
69.             (setq new-en
    
70.               (entmake
    
71.                 (list
    
72.                   '(0 . "TEXT")
    
73.                   '(100 . "AcDbEntity")
    
74.                   '(100 . "AcDbText")
    
75.                   (cons 10 pt)
    
76.                   (cons 40 (cdr (assoc 40 ent)))
    
77.                   (cons 1 field-str)
    
78.                   (cons 7 (cdr (assoc 7 ent)))
    
79.                   (cons 8 (cdr (assoc 8 ent)))
    
80.                   (if (assoc 62 ent) (assoc 62 ent) '(62 . 256)) ; 随层颜色
    
81.                   (cons 50 (cdr (assoc 50 ent)))
    
82.                   (cons 41 (cdr (assoc 41 ent)))
    
83.                 )
    
84.               )
    
85.             )
    
86. 
    
87.             ;; 刷新显示
    
88.             (if new-en
    
89.               (progn
    
90.                 (setq new-obj-ename (entlast))
    
91.                 ;; 2007 中字段有时需要 Regen 或 UpdateField
    
92.                 (vl-cmdf "_.UPDATEFIELD" new-obj-ename "")
    
93.                 (entupd new-obj-ename)
    
94.               )
    
95.             )
    
96. 
    
97.             (setq inc-val (1+ inc-val))
    
98.           )
    
99.         )
    
100.         (princ "\n错误: 所选文字不是有效的数字。")
     
101.       )
     
102.     )
     
103.     (princ "\n未选中 TEXT 对象。")
     
104.   )
     
105. 
     
106.   (vla-EndUndoMark doc)
     
107.   (setvar "CMDECHO" 1)
     
108.   (princ)
     
109. )
     
110. 
     
111. (princ "\n适配版 NumLink 已加载。输入 NUMLINK 运行。")
     
112. (princ)

(vl-load-com)<br /> <br /> (defun c:NumLink (/ *error* js en ent vla-obj <br />                     str-val pt <br />                     obj-id field-str<br />                     acad-obj doc util<br />                     inc-val new-en)<br /> <br />   ;; 1. 错误处理<br />   (defun *error* (msg)<br />     (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*")))<br />       (princ (strcat "\n错误: " msg))<br />     )<br />     (if doc (vla-EndUndoMark doc))<br />     (setvar "CMDECHO" 1)<br />     (princ)<br />   )<br /> <br />   ;; 2. 初始化<br />   (setq acad-obj (vlax-get-acad-object))<br />   (setq doc (vla-get-ActiveDocument acad-obj))<br />   (setq util (vla-get-Utility doc)) <br /> <br />   (vla-StartUndoMark doc)<br />   (setvar "CMDECHO" 0)<br /> <br />   ;; 3. 校验函数<br />   (defun Is-String-Numeric (str)<br />     (if (distof str) T nil)<br />   )<br /> <br />   ;; 4. 获取 ObjectID (适配 2007 32位环境)<br />   (defun Get-Field-ObjectID (obj)<br />     ;; 2007版本直接获取ObjectID即可，转换为字符串<br />     (vl-princ-to-string (vla-get-ObjectID obj))<br />   )<br /> <br />   ;; 5. 主逻辑<br />   (princ "\n请选择基准数字文字 (TEXT): ")<br /> <br />   (if (setq js (ssget ":S" '((0 . "TEXT"))))<br />     (progn<br />       (setq en (ssname js 0))<br />       (setq ent (entget en))<br />       (setq vla-obj (vlax-ename->vla-object en))<br />       (setq str-val (cdr (assoc 1 ent)))<br /> <br />       (if (Is-String-Numeric str-val)<br />         (progn<br />           (setq obj-id (Get-Field-ObjectID vla-obj))<br />           (setq inc-val 1)<br /> <br />           ;; 循环放置<br />           (while (setq pt (getpoint (strcat "\n放置位置 (当前基准 +" (itoa inc-val) ") [右键或ESC退出]: ")))<br /> <br />             ;; 构建 2007 兼容的字段表达式<br />             ;; 注意：2007 字段中的 ObjId 后面不一定需要额外的控制字符<br />             (setq field-str <br />               (strcat <br />                 "%<\\AcExpr (%<\\AcObjProp Object(%<\\_ObjId " <br />                 obj-id <br />                 ">%).TextString>% + " <br />                 (itoa inc-val) <br />                 ") \\f \"%lu2%pr0\">%"<br />               )<br />             )<br /> <br />             ;; 生成文字 (entmake 在 2007 中非常稳定)<br />             (setq new-en <br />               (entmake <br />                 (list<br />                   '(0 . "TEXT")<br />                   '(100 . "AcDbEntity")<br />                   '(100 . "AcDbText")<br />                   (cons 10 pt)<br />                   (cons 40 (cdr (assoc 40 ent)))<br />                   (cons 1 field-str)<br />                   (cons 7 (cdr (assoc 7 ent)))<br />                   (cons 8 (cdr (assoc 8 ent)))<br />                   (if (assoc 62 ent) (assoc 62 ent) '(62 . 256)) ; 随层颜色<br />                   (cons 50 (cdr (assoc 50 ent)))<br />                   (cons 41 (cdr (assoc 41 ent)))<br />                 )<br />               )<br />             )<br /> <br />             ;; 刷新显示<br />             (if new-en<br />               (progn<br />                 (setq new-obj-ename (entlast))<br />                 ;; 2007 中字段有时需要 Regen 或 UpdateField<br />                 (vl-cmdf "_.UPDATEFIELD" new-obj-ename "")<br />                 (entupd new-obj-ename)<br />               )<br />             )<br /> <br />             (setq inc-val (1+ inc-val))<br />           )<br />         )<br />         (princ "\n错误: 所选文字不是有效的数字。")<br />       )<br />     )<br />     (princ "\n未选中 TEXT 对象。")<br />   )<br /> <br />   (vla-EndUndoMark doc)<br />   (setvar "CMDECHO" 1)<br />   (princ)<br /> )<br /> <br /> (princ "\n适配版 NumLink 已加载。输入 NUMLINK 运行。")<br /> (princ)

tigcat

年底了，楼主这头像，哈哈哈。

tranque

tigcat 发表于 2026-1-5 16:54
年底了，楼主这头像，哈哈哈。

被他发自内心的真心笑容感染了，这个瞬间，我想张子强先生一定是自豪和幸福的

不一样地设计

感谢分享。  

jkop

应用上可以搭配流水号 ，图面编号使用，收藏！

asdttkjn

牛啊 学习一下