新人第一次发帖

JS结构

kucha007 发表于 2022-12-6 21:45
也尝试了一下

弱弱问一下：为什么要定义出错函数呢，不太了解这个的用处

JS结构

depgfdepgf 发表于 2022-12-7 09:03
长宽比出来的洞口线比例不好看，希望再次改进下

大佬有什么好的思路提示一下吗

kucha007

JS结构 发表于 2022-12-6 20:53
感谢大佬~ 不明觉厉！我还得多多学习

一般用在ESC或者发生错误退出时恢复之前保存的变量。
举个例子：你记录了当前图层后切换了图层，执行程序后恢复图层。如果程序出错没有执行到恢复图层这一步就不好啦~这个时候就可以用出错函数来恢复保存的变量

kucha007

又试了一下，加了线型

2. (defun c:TT (/ Old_Cmd Old_OSM obj ptlist pmin pmax pmid co lt *ent*)
   
3.   (setq Old_Cmd (getvar "cmdecho"))
   
4.   (setq Old_OSM (getvar "OSMode"))
   
5.   (defun *error* ( msg );定义出错函数
   
6.       (setvar "cmdecho" Old_Cmd)
   
7.       (setvar "OSMode" Old_OSM)
   
8.   )
   
9.   (setvar "cmdecho" 0)
   
10.   (command "_.rectangle" "_fillet" 0.0) ;圆角归零
    
11.   (while (/= 0 (getvar 'cmdactive))(vl-cmdf pause))
    
12.   (setvar "OSMode" 0)
    
13.   (if (and
    
14.           (setq obj (entget (entlast)))
    
15.           (setq ptlist
    
16.               (vl-sort
    
17.                     (mapcar
    
18.                         '(lambda (pt)
    
19.                             (trans
    
20.                               (list
    
21.                                 (car pt);X
    
22.                                 (cadr pt);Y
    
23.                                 (cdr (assoc 38 obj)) ;Z
    
24.                               )
    
25.                               0 1
    
26.                             )
    
27.                         );WCS to UCS
    
28.                         (mapcar 'cdr
    
29.                             (vl-remove-if '(lambda (x) (/= (car x) 10)) obj)
    
30.                         );获取WCS坐标
    
31.                     );获取UCS点集
    
32.                   '(lambda (a b)
    
33.                           (cond
    
34.                             ((= (car a) (car b)) (< (cadr a) (cadr b)));如果x相等，就比较y
    
35.                             ((< (car a) (car b))) ;如果x不相等，就比较x
    
36.                           )
    
37.                       )
    
38.               ) ;排序:先X后Y
    
39.           )
    
40.           (setq pmin (car ptlist))
    
41.           (setq pmax (car (reverse ptlist)))
    
42.           (setq pmid (mapcar '+
    
43.                             pmin
    
44.                             (mapcar '* (mapcar '- pmax pmin) '(0.25 0.6))
    
45.                     )
    
46.           )
    
47.       )
    
48.       (progn
    
49.           (command "_.pline" pmin pmid pmax "")
    
50.           (setq *ent* (entget (entlast)))
    
51.           (setq co 8);8号色
    
52.           (setq lt "DASHED");线型
    
53.           (if (assoc 62 *ent*)
    
54.             (entmod (subst (cons 62 co) (assoc 62 *ent*) *ent*)) ;替换颜色
    
55.             (entmod (append *ent* (list (cons 62 co)))) ;添加颜色
    
56.           )
    
57.           (if (not (tblsearch "ltype" lt))
    
58.             (vla-load (vla-get-linetypes (vla-get-activedocument (vlax-get-acad-object))) lt "acadiso.lin")
    
59.           )
    
60.           (if (assoc 6 *ent*)
    
61.             (entmod (subst (cons 6 lt) (assoc 6 *ent*) *ent*)) ;替换线型
    
62.             (entmod (append *ent* (list (cons 6 lt)))) ;添加线型
    
63.           )
    
64.       )
    
65.   )
    
66.   (setvar "cmdecho" Old_Cmd)
    
67.   (setvar "OSMode" Old_OSM)
    
68.   (princ)
    
69. )

(defun c:TT (/ Old_Cmd Old_OSM obj ptlist pmin pmax pmid co lt *ent*) <br />   (setq Old_Cmd (getvar "cmdecho"))<br />   (setq Old_OSM (getvar "OSMode"))<br />   (defun *error* ( msg );定义出错函数<br />       (setvar "cmdecho" Old_Cmd)<br />       (setvar "OSMode" Old_OSM)<br />   )<br />   (setvar "cmdecho" 0)<br />   (command "_.rectangle" "_fillet" 0.0) ;圆角归零<br />   (while (/= 0 (getvar 'cmdactive))(vl-cmdf pause))<br />   (setvar "OSMode" 0)<br />   (if (and<br />           (setq obj (entget (entlast)))<br />           (setq ptlist <br />               (vl-sort <br />                     (mapcar <br />                         '(lambda (pt) <br />                             (trans <br />                               (list <br />                                 (car pt);X<br />                                 (cadr pt);Y<br />                                 (cdr (assoc 38 obj)) ;Z<br />                               )<br />                               0 1<br />                             )<br />                         );WCS to UCS<br />                         (mapcar 'cdr <br />                             (vl-remove-if '(lambda (x) (/= (car x) 10)) obj)<br />                         );获取WCS坐标<br />                     );获取UCS点集<br />                   '(lambda (a b) <br />                           (cond <br />                             ((= (car a) (car b)) (< (cadr a) (cadr b)));如果x相等，就比较y<br />                             ((< (car a) (car b))) ;如果x不相等，就比较x<br />                           )<br />                       )<br />               ) ;排序:先X后Y<br />           )<br />           (setq pmin (car ptlist))<br />           (setq pmax (car (reverse ptlist)))<br />           (setq pmid (mapcar '+ <br />                             pmin<br />                             (mapcar '* (mapcar '- pmax pmin) '(0.25 0.6))<br />                     )<br />           )<br />       )<br />       (progn<br />           (command "_.pline" pmin pmid pmax "")<br />           (setq *ent* (entget (entlast)))<br />           (setq co 8);8号色<br />           (setq lt "DASHED");线型<br />           (if (assoc 62 *ent*) <br />             (entmod (subst (cons 62 co) (assoc 62 *ent*) *ent*)) ;替换颜色<br />             (entmod (append *ent* (list (cons 62 co)))) ;添加颜色<br />           )<br />           (if (not (tblsearch "ltype" lt))<br />             (vla-load (vla-get-linetypes (vla-get-activedocument (vlax-get-acad-object))) lt "acadiso.lin")<br />           )<br />           (if (assoc 6 *ent*) <br />             (entmod (subst (cons 6 lt) (assoc 6 *ent*) *ent*)) ;替换线型<br />             (entmod (append *ent* (list (cons 6 lt)))) ;添加线型<br />           )<br />       )<br />   )<br />   (setvar "cmdecho" Old_Cmd)<br />   (setvar "OSMode" Old_OSM)<br />   (princ)<br /> )

JS结构

kucha007 发表于 2022-12-7 21:36
一般用在ESC或者发生错误退出时恢复之前保存的变量。
举个例子：你记录了当前图层后切换了图层，执行程 ...

学到了 学到了  感谢大佬