各位大神，求一个画矩形的功能，输入tt,然后在图纸上画矩形，要求图层为templayerName

664571221

各位大神，求一个画矩形的功能，输入tt,然后在图纸上画矩形，要求图层为templayerName，颜色为黄色，线宽100

你有种再说一遍

你让AI写就好了啊,这种基础的还是写得出来的

tranque

2. (defun c:TT (/ pt1 pt2 layer-name)
   
3.   ;; 设置图层信息
   
4.   (setq layer-name "templayerName")
   
5.   
   
6.   ;; 创建或设置图层
   
7.   (if (not (tblsearch "LAYER" layer-name))
   
8.     (progn
   
9.       (command "_.-LAYER"
   
10.                "_M" layer-name
    
11.                "_C" "2" "" ; 黄色
    
12.                "_LW" "0.1" "" ; 0.1毫米线宽
    
13.                ""
    
14.       )
    
15.     )
    
16.     (command "_.-LAYER" "_S" layer-name "")
    
17.   )
    
18.   
    
19.   ;; 获取用户输入
    
20.   (setq pt1 (getpoint "\n指定矩形第一角点: "))
    
21.   (if (not pt1) (exit)) ; 如果取消则退出
    
22.   
    
23.   (setq pt2 (getcorner pt1 "\n指定对角点: "))
    
24.   (if (not pt2) (exit)) ; 如果取消则退出
    
25.   
    
26.   ;; 绘制带宽度矩形
    
27.   (command "_.PLINE"
    
28.            "_non" pt1   ; 使用非捕捉模式
    
29.            "_W" "100" "100" ; 设置线宽
    
30.            "_non" (list (car pt1) (cadr pt2)) ; 左上角点
    
31.            "_non" pt2   ; 右上角点
    
32.            "_non" (list (car pt2) (cadr pt1)) ; 左下角点
    
33.            "_C" ; 闭合
    
34.   )
    
35.   (princ)
    
36. )

(defun c:TT (/ pt1 pt2 layer-name)<br />   ;; 设置图层信息<br />   (setq layer-name "templayerName")<br />   <br />   ;; 创建或设置图层<br />   (if (not (tblsearch "LAYER" layer-name))<br />     (progn<br />       (command "_.-LAYER"<br />                "_M" layer-name<br />                "_C" "2" "" ; 黄色<br />                "_LW" "0.1" "" ; 0.1毫米线宽<br />                ""<br />       )<br />     )<br />     (command "_.-LAYER" "_S" layer-name "")<br />   )<br />   <br />   ;; 获取用户输入<br />   (setq pt1 (getpoint "\n指定矩形第一角点: "))<br />   (if (not pt1) (exit)) ; 如果取消则退出<br />   <br />   (setq pt2 (getcorner pt1 "\n指定对角点: "))<br />   (if (not pt2) (exit)) ; 如果取消则退出<br />   <br />   ;; 绘制带宽度矩形<br />   (command "_.PLINE"<br />            "_non" pt1   ; 使用非捕捉模式<br />            "_W" "100" "100" ; 设置线宽<br />            "_non" (list (car pt1) (cadr pt2)) ; 左上角点<br />            "_non" pt2   ; 右上角点<br />            "_non" (list (car pt2) (cadr pt1)) ; 左下角点<br />            "_C" ; 闭合<br />   )<br />   (princ)<br /> )

664571221

tranque 发表于 2025-5-30 17:18

谢谢兄弟，非常感谢。

664571221

tranque 发表于 2025-5-30 17:18

Error: 输入的列表有缺陷

tranque

664571221 发表于 2025-5-30 17:49
Error: 输入的列表有缺陷

存的ANSI格式吗

tranque

画矩形TT，tx元宝生成

332398174

哈哈11111111111111

嘒彼小星

之前不是给弄过的吗

2. (defun c:t1(/ la co)
   
3.   (setq la(getvar "CLAYER"));当前图层
   
4.   (setq co(getvar "CECOLOR"))
   
5.   (if (= (tblsearch "layer" "templayerName") nil)(entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") '(70 . 0) '(6 . "Continuous")(cons 2 "templayerName"))))
   
6.   (setvar "CLAYER" "templayerName")
   
7.   (setvar "CECOLOR" "2")
   
8.   (vl-cmdf "_.RECTANG" "w" "100" pause pause)
   
9.   (setvar "CLAYER" la)
   
10.   (setvar "CECOLOR" co)
    
11. )

(defun c:t1(/ la co)<br />   (setq la(getvar "CLAYER"));当前图层<br />   (setq co(getvar "CECOLOR"))<br />   (if (= (tblsearch "layer" "templayerName") nil)(entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") '(70 . 0) '(6 . "Continuous")(cons 2 "templayerName"))))<br />   (setvar "CLAYER" "templayerName")<br />   (setvar "CECOLOR" "2")<br />   (vl-cmdf "_.RECTANG" "w" "100" pause pause)<br />   (setvar "CLAYER" la)<br />   (setvar "CECOLOR" co)<br /> )