deepseek源码，批量标注

a405692168

用 deepseek源码写了个批量标注插件,主要想代替CAD自带命令"QDIM"，能加载，但运行不出结果，大佬们帮忙看下修正下。。。

1. (defun c:PLBZ (/ *error* osmode cmdecho pt1 pt2 ss filtered-entities dimlayer)
   
2.   ;; 错误处理函数
   
3.   (defun *error* (msg)
   
4.     (if osmode (setvar "osmode" osmode)) ;; 还原捕捉设置
   
5.     (if cmdecho (setvar "cmdecho" cmdecho)) ;; 还原命令回显
   
6.     (princ "\n程序终止")
   
7.   )
   
8. 
   
9.   ;; 保存当前设置
   
10.   (setq osmode (getvar "osmode")
    
11.         cmdecho (getvar "cmdecho"))
    
12.   (setvar "cmdecho" 0)
    
13. 
    
14.   ;; 检查或创建 "dim" 图层
    
15.   (setq dimlayer "dim")
    
16.   (if (not (tblsearch "layer" dimlayer))
    
17.     (command "._layer" "_m" dimlayer "")
    
18.   )
    
19. 
    
20.   ;; 主程序
    
21.   (princ "\n拉线批量标注插件 - 命令: PLBZ")
    
22.   (princ "\n指定标注起始点和方向点，支持水平和垂直方向标注。")
    
23. 
    
24.   ;; 获取标注起始点
    
25.   (setq pt1 (getpoint "\n指定标注起始点: "))
    
26.   (if (not pt1)
    
27.     (progn
    
28.       (princ "\n未指定起始点，程序退出。")
    
29.       (exit)
    
30.     )
    
31.   )
    
32. 
    
33.   ;; 获取标注方向点
    
34.   (setq pt2 (getpoint pt1 "\n指定标注方向点: "))
    
35.   (if (not pt2)
    
36.     (progn
    
37.       (princ "\n未指定方向点，程序退出。")
    
38.       (exit)
    
39.     )
    
40.   )
    
41. 
    
42.   ;; 过滤实体
    
43.   (setq filtered-entities (filter-entities pt1 pt2))
    
44.   (if (not filtered-entities)
    
45.     (progn
    
46.       (princ "\n未找到符合条件的实体，程序退出。")
    
47.       (exit)
    
48.     )
    
49.   )
    
50. 
    
51.   ;; 创建标注
    
52.   (create-dimensions filtered-entities pt1 pt2 dimlayer)
    
53. 
    
54.   ;; 尺寸文字避让
    
55.   (text-avoidance)
    
56. 
    
57.   ;; 还原设置
    
58.   (setvar "osmode" osmode)
    
59.   (setvar "cmdecho" cmdecho)
    
60.   (princ "\n标注完成。")
    
61.   (prin1)
    
62. )
    
63. 
    
64. ;; 过滤实体函数
    
65. (defun filter-entities (pt1 pt2 / ss filtered)
    
66.   (setq ss (ssget "F" (list pt1 pt2)
    
67.                '((-4 . "<NOT")
    
68.                  (-4 . "<OR")
    
69.                    (0 . "TEXT,DIMENSION,INSERT,MTEXT,HATCH") ;; 过滤实体类型
    
70.                    (8 . "五金,点划线") ;; 过滤图层
    
71.                  (-4 . "OR>")
    
72.                (-4 . "NOT>"))))
    
73.   (if ss
    
74.     (progn
    
75.       (setq filtered (vl-remove-if-not
    
76.                        '(lambda (x)
    
77.                           (and (not (member (cdr (assoc 0 (entget x))) '("TEXT" "DIMENSION" "INSERT" "MTEXT" "HATCH")))
    
78.                                (not (member (cdr (assoc 8 (entget x))) '("五金" "点划线")))))
    
79.                        (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
    
80.       filtered)
    
81.     nil)
    
82. )
    
83. 
    
84. ;; 创建标注函数
    
85. (defun create-dimensions (entities pt1 pt2 dimlayer / ang pt)
    
86.   (setq ang (angle pt1 pt2))
    
87.   (foreach ent entities
    
88.     (setq pt (cdr (assoc 10 (entget ent))))
    
89.     (if (or (equal ang 0.0 0.01) (equal ang pi 0.01)) ;; 水平方向
    
90.       (entmake
    
91.         (list
    
92.           '(0 . "DIMENSION")
    
93.           '(100 . "AcDbEntity")
    
94.           '(100 . "AcDbDimension")
    
95.           (cons 8 dimlayer) ;; 设置标注图层
    
96.           (cons 10 pt)
    
97.           '(70 . 32) ;; 水平标注
    
98.           '(1 . "") ;; 尺寸文字
    
99.           '(100 . "AcDbAlignedDimension")
    
100.           (cons 13 pt)
     
101.           (cons 14 (polar pt ang 10.0)) ;; 标注长度
     
102.         )
     
103.       )
     
104.     (if (or (equal ang (/ pi 2) 0.01) (equal ang (* pi 1.5) 0.01)) ;; 垂直方向
     
105.       (entmake
     
106.         (list
     
107.           '(0 . "DIMENSION")
     
108.           '(100 . "AcDbEntity")
     
109.           '(100 . "AcDbDimension")
     
110.           (cons 8 dimlayer) ;; 设置标注图层
     
111.           (cons 10 pt)
     
112.           '(70 . 33) ;; 垂直标注
     
113.           '(1 . "") ;; 尺寸文字
     
114.           '(100 . "AcDbAlignedDimension")
     
115.           (cons 13 pt)
     
116.           (cons 14 (polar pt ang 10.0)) ;; 标注长度
     
117.         )
     
118.       )
     
119.     )
     
120.   )
     
121. ))
     
122. 
     
123. ;; 尺寸文字避让函数
     
124. (defun text-avoidance (/ ss i ent data pt1 pt2)
     
125.   (setq ss (ssget "_X" '((0 . "DIMENSION"))))
     
126.   (if ss
     
127.     (progn
     
128.       (setq i 0)
     
129.       (repeat (sslength ss)
     
130.         (setq ent (ssname ss i)
     
131.               data (entget ent)
     
132.               pt1 (cdr (assoc 13 data))
     
133.               pt2 (cdr (assoc 14 data)))
     
134.         ;; 调整文字位置
     
135.         (entmod (subst (cons 11 (polar (mapcar '* (mapcar '+ pt1 pt2) '(0.5 0.5 0.5)) (assoc 11 data) data))
     
136.         (setq i (1+ i))
     
137.       )
     
138.     )
     
139.   )
     
140. )))

(defun c:PLBZ (/ *error* osmode cmdecho pt1 pt2 ss filtered-entities dimlayer)<br />   ;; 错误处理函数<br />   (defun *error* (msg)<br />     (if osmode (setvar "osmode" osmode)) ;; 还原捕捉设置<br />     (if cmdecho (setvar "cmdecho" cmdecho)) ;; 还原命令回显<br />     (princ "\n程序终止")<br />   )<br /> <br />   ;; 保存当前设置<br />   (setq osmode (getvar "osmode")<br />         cmdecho (getvar "cmdecho"))<br />   (setvar "cmdecho" 0)<br /> <br />   ;; 检查或创建 "dim" 图层<br />   (setq dimlayer "dim")<br />   (if (not (tblsearch "layer" dimlayer))<br />     (command "._layer" "_m" dimlayer "")<br />   )<br /> <br />   ;; 主程序<br />   (princ "\n拉线批量标注插件 - 命令: PLBZ")<br />   (princ "\n指定标注起始点和方向点，支持水平和垂直方向标注。")<br /> <br />   ;; 获取标注起始点<br />   (setq pt1 (getpoint "\n指定标注起始点: "))<br />   (if (not pt1)<br />     (progn<br />       (princ "\n未指定起始点，程序退出。")<br />       (exit)<br />     )<br />   )<br /> <br />   ;; 获取标注方向点<br />   (setq pt2 (getpoint pt1 "\n指定标注方向点: "))<br />   (if (not pt2)<br />     (progn<br />       (princ "\n未指定方向点，程序退出。")<br />       (exit)<br />     )<br />   )<br /> <br />   ;; 过滤实体<br />   (setq filtered-entities (filter-entities pt1 pt2))<br />   (if (not filtered-entities)<br />     (progn<br />       (princ "\n未找到符合条件的实体，程序退出。")<br />       (exit)<br />     )<br />   )<br /> <br />   ;; 创建标注<br />   (create-dimensions filtered-entities pt1 pt2 dimlayer)<br /> <br />   ;; 尺寸文字避让<br />   (text-avoidance)<br /> <br />   ;; 还原设置<br />   (setvar "osmode" osmode)<br />   (setvar "cmdecho" cmdecho)<br />   (princ "\n标注完成。")<br />   (prin1)<br /> )<br /> <br /> ;; 过滤实体函数<br /> (defun filter-entities (pt1 pt2 / ss filtered)<br />   (setq ss (ssget "F" (list pt1 pt2)<br />                '((-4 . "<NOT")<br />                  (-4 . "<OR")<br />                    (0 . "TEXT,DIMENSION,INSERT,MTEXT,HATCH") ;; 过滤实体类型<br />                    (8 . "五金,点划线") ;; 过滤图层<br />                  (-4 . "OR>")<br />                (-4 . "NOT>"))))<br />   (if ss<br />     (progn<br />       (setq filtered (vl-remove-if-not<br />                        '(lambda (x)<br />                           (and (not (member (cdr (assoc 0 (entget x))) '("TEXT" "DIMENSION" "INSERT" "MTEXT" "HATCH")))<br />                                (not (member (cdr (assoc 8 (entget x))) '("五金" "点划线")))))<br />                        (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))<br />       filtered)<br />     nil)<br /> )<br /> <br /> ;; 创建标注函数<br /> (defun create-dimensions (entities pt1 pt2 dimlayer / ang pt)<br />   (setq ang (angle pt1 pt2))<br />   (foreach ent entities<br />     (setq pt (cdr (assoc 10 (entget ent))))<br />     (if (or (equal ang 0.0 0.01) (equal ang pi 0.01)) ;; 水平方向<br />       (entmake<br />         (list<br />           '(0 . "DIMENSION")<br />           '(100 . "AcDbEntity")<br />           '(100 . "AcDbDimension")<br />           (cons 8 dimlayer) ;; 设置标注图层<br />           (cons 10 pt)<br />           '(70 . 32) ;; 水平标注<br />           '(1 . "") ;; 尺寸文字<br />           '(100 . "AcDbAlignedDimension")<br />           (cons 13 pt)<br />           (cons 14 (polar pt ang 10.0)) ;; 标注长度<br />         )<br />       )<br />     (if (or (equal ang (/ pi 2) 0.01) (equal ang (* pi 1.5) 0.01)) ;; 垂直方向<br />       (entmake<br />         (list<br />           '(0 . "DIMENSION")<br />           '(100 . "AcDbEntity")<br />           '(100 . "AcDbDimension")<br />           (cons 8 dimlayer) ;; 设置标注图层<br />           (cons 10 pt)<br />           '(70 . 33) ;; 垂直标注<br />           '(1 . "") ;; 尺寸文字<br />           '(100 . "AcDbAlignedDimension")<br />           (cons 13 pt)<br />           (cons 14 (polar pt ang 10.0)) ;; 标注长度<br />         )<br />       )<br />     )<br />   )<br /> ))<br /> <br /> ;; 尺寸文字避让函数<br /> (defun text-avoidance (/ ss i ent data pt1 pt2)<br />   (setq ss (ssget "_X" '((0 . "DIMENSION"))))<br />   (if ss<br />     (progn<br />       (setq i 0)<br />       (repeat (sslength ss)<br />         (setq ent (ssname ss i)<br />               data (entget ent)<br />               pt1 (cdr (assoc 13 data))<br />               pt2 (cdr (assoc 14 data)))<br />         ;; 调整文字位置<br />         (entmod (subst (cons 11 (polar (mapcar '* (mapcar '+ pt1 pt2) '(0.5 0.5 0.5)) (assoc 11 data) data))<br />         (setq i (1+ i))<br />       )<br />     )<br />   )<br /> )))

qazxswk

想要这样的效果吗？

liuhe

zmzk 发表于 2025-2-13 18:28
好奇，怎么看出 是用ai 写的代码啊？看来ai 与人抢饭碗的时代来了

用 deepseek源码写了个批量标注插件,主要想代替CAD自带命令"QDIM"，能加载，但运行不出结果，大佬们帮忙看下修正下。。

gzcsun

linzaijie 发表于 2025-2-15 08:21
其它别说,,,人家这个AI写出来的程序有条有理,,,分开一个个小函数...看得很清楚....论谈里很多大神与的lisp ...

功能能正常用就可以。你以为程序很容易的，改了多次后都懒得去条理化。

liuhe

又来这种用ai写代码，靠别人改代码的帖子。

zmzk

liuhe 发表于 2025-2-13 17:22
又来这种用ai写代码，靠别人改代码的帖子。

好奇，怎么看出 是用ai 写的代码啊？看来ai 与人抢饭碗的时代来了

gaolei_gaolei

多问几次deepseek让他改，他会改好的，我让他写过，多改几次就能用的，有热心的大哥能帮就帮，不想帮的直接略过，没必要出言讽刺，

kozmosovia

白嫖DS和白嫖论坛高手相比，还是白嫖DS更靠得住，起码服务态度好。

a405692168

主要最近deepseek火，所以试了一下，但AI写出来的还是不行，AI取代人力还早。。。。

GEGEYANG88

AI没有想象力，这是最本质的区别，人有！

fsafaffa

deepseek写的，就找deepseek改

linzaijie

其它别说,,,人家这个AI写出来的程序有条有理,,,分开一个个小函数...看得很清楚....论谈里很多大神与的lisp程序像屎一个...又臭又长,,,功能像是能正常用.....