求助!修改中心线和序

fqqc

各位高手,你们好,帮我修改一下下面的程序:

(defun c:cl ()
   (setvar "cmdecho" 0)
   (setq os_old (getvar "osmode"))
   (setq cl_old (getvar "clayer"))
   (setvar "osmode" 0)
   (command "ucs" "")
;-----------------------------------------------------------------------------------------
   (if (not (tblsearch "layer" "cen"))
       (command "_.layer" "_new" "cen" "_color" "1" "cen" "_ltype" "center" "cen" "")
       (command "_.layer" "thaw" "cen" "on" "cen" "unlock" "cen" "")
   )
;------------------------------------------------------------------------------------------
  (setq a1 (entsel "\n请选定要画中心线的圆\\圆弧\\直线:"))
  (while (null a1)
       (setq a1 (entsel "\n请选定要画中心线的圆\\圆弧\\直线:"))
  )
  (setq a2 (entget (car a1)))
  (setq l1 (assoc 0 a2))
  (setq l2 (cdr l1))
  (while (and (/= l2 "LINE") (/= l2 "ARC") (/= l2 "CIRCLE"))
         (setq a1 (entsel "\n所选的不是圆\\圆弧\\直线:"))
         (while (null a1)
            (setq a1 (entsel "\n请选定要画中心线的圆\\圆弧\\直线:"))
         )
         (setq pt1 (cadr a1))
         (setq a2 (entget (car a1)))
         (setq l1 (assoc 0 a2))
         (setq l2 (cdr l1))
  )
  (if (or (= l2 "ARC") (= l2 "CIRCLE"))
      (progn
          (setq b1 (cdr (assoc 10 a2)))  ;圆心座标
          (setq b2 (cdr (assoc 40 a2)))  ;圆半径
          (setvar "clayer" "cen")
          (command "line" (list (- (car b1) (* b2 1.2)) (cadr b1)) (strcat "@" (rtos (* b2 2.4))
                          "<0") "")
          (command "array" "l" "" "p" b1 "2" "90" "")
      )
   )
  (if (or (= l2 "LINE"))
      (progn
          (setq a3 (entsel "\n请选定另一直线:"))
          (while (null a3)
                 (setq a3 (entsel "\n请选定另一直线:"))
          )
          (setq a4 (entget (car a3)))
          (setq end1 (cdr (assoc 10 a2)))
          (setq end2 (cdr (assoc 11 a2)))
          (setq end3 (cdr (assoc 10 a4)))
          (setq end4 (cdr (assoc 11 a4)))
          (setq e1 (distance end1 end3))
          (setq e2 (distance end1 end4))
          (if (< e1 e2)
             (progn
              (setq end5 (list (/ (+ (car end1) (car end3)) 2.0) (/ (+ (cadr end1) (cadr end3)) 2.0)))
              (setq end6 (list (/ (+ (car end2) (car end4)) 2.0) (/ (+ (cadr end2) (cadr end4)) 2.0)))
             )
             (progn
              (setq end5 (list (/ (+ (car end1) (car end4)) 2.0) (/ (+ (cadr end1) (cadr end4)) 2.0)))
              (setq end6 (list (/ (+ (car end2) (car end3)) 2.0) (/ (+ (cadr end2) (cadr end3)) 2.0)))
             )
          )
          (setq end5_1 (polar end5 (angle end6 end5) 10))
          (setq end6_1 (polar end6 (angle end5 end6) 10))
          (setvar "clayer" "cen")
          (command "line" end5_1 end6_1 "")
      )
   )
   (setvar "osmode" os_old)
   (setvar "clayer" cl_old)
   (princ)
)

在画中心线时如果中断,我设置好的自动捕捉就全没有了,而且没有中断命令,设置好的坐标系也会自动跳掉啦!

谢谢!

phoenixdjq

做个出错函数就可以了

fqqc

能帮帮我吗,我不怎么懂呢,

fqqc

二楼的兄弟,你还在线吗,帮我修改一下啦,我感激不尽

yshf

随手改了一下

2. (defun c:cl ()
3.    (setvar "cmdecho" 0)
4.    (setq os_old (getvar "osmode"))
5.    (setq cl_old (getvar "clayer"))
6.   
7.    (setq olderr *error*)
8.    (defun *error*(msg)
9.       (command "_undo" "b")
10.       (setvar "osmode" os_old)
11.       (setvar "clayer" cl_old)
12.       (setq *error* olderr)(princ)
13.    )
14.    (command "_undo" "m")
15.   
16.    (setvar "osmode" 0)
17.    (command "ucs" "")
18. ;-----------------------------------------------------------------------------------------
19.    (if (not (tblsearch "layer" "cen"))
20.        (command "_.layer" "_new" "cen" "_color" "1" "cen" "_ltype" "center" "cen" "")
21.        (command "_.layer" "thaw" "cen" "on" "cen" "unlock" "cen" "")
22.    )
23. ;------------------------------------------------------------------------------------------
24.   
25.   
26.   (while (setq a1 (entsel "\n请选定要画中心线的圆\\圆弧\\直线:"))
27.      (setq a2 (entget (car a1)))
28.      (setq l1 (assoc 0 a2))
29.      (setq l2 (cdr l1))
30.      (if (not (wcmatch l2 "LINE,ARC,CIRCLE"))
31.          (princ "\n所选的不是圆\\圆弧\\直线!")
32.          (progn
33.             (cond ((wcmatch l2 "ARC,CIRCLE")
34.        (setq b1 (cdr (assoc 10 a2)))  ;圆心座标
35.                      (setq b2 (cdr (assoc 40 a2)))  ;圆半径
36.                      (setvar "clayer" "cen")
37.                      (command "line" (list (- (car b1) (* b2 1.2)) (cadr b1)) (strcat "@" (rtos (* b2 2.4))
38.                           "<0") "")
39.                      (command "array" (entlast) "" "p" b1 "2" "90" "")
40.     )
41.     ((= l2 "LINE")
42.                       (while (not (setq a3 (entsel "\n请选定另一直线:")))
43.                          (princ "\n没有选定另一直线!")
44.                       )
45.         (setq a4 (entget (car a3)))
46.                       (setq end1 (cdr (assoc 10 a2)))
47.                       (setq end2 (cdr (assoc 11 a2)))
48.                       (setq end3 (cdr (assoc 10 a4)))
49.                       (setq end4 (cdr (assoc 11 a4)))
50.                       (setq e1 (distance end1 end3))
51.                       (setq e2 (distance end1 end4))
52.                       (if (< e1 e2)
53.      (setq end5 (mapcar '* '(0.5 0.5) (mapcar '+ end1 end3))
54.     end6 (mapcar '* '(0.5 0.5) (mapcar '+ end2 end4))
55.      )
56.      (setq end5 (mapcar '* '(0.5 0.5) (mapcar '+ end1 end4))
57.           end6 (mapcar '* '(0.5 0.5) (mapcar '+ end2 end3))
58.      )
59.                            
60.                       )
61.                       (setq end5_1 (polar end5 (angle end6 end5) 10))
62.                       (setq end6_1 (polar end6 (angle end5 end6) 10))
63.                       (setvar "clayer" "cen")
64.                       (command "line" end5_1 end6_1 "")
65.                      
66.     )
67.         )
68.      )
69.   )
70.    )
71.    (setq *error* olderr)
72.    (setvar "osmode" os_old)
73.    (setvar "clayer" cl_old)
74.    (princ)
75. )

(defun c:cl ()    (setvar "cmdecho" 0)    (setq os_old (getvar "osmode"))    (setq cl_old (getvar "clayer"))       (setq olderr *error*)    (defun *error*(msg)       (command "_undo" "b")       (setvar "osmode" os_old)       (setvar "clayer" cl_old)       (setq *error* olderr)(princ)    )    (command "_undo" "m")       (setvar "osmode" 0)    (command "ucs" "") ;-----------------------------------------------------------------------------------------    (if (not (tblsearch "layer" "cen"))        (command "_.layer" "_new" "cen" "_color" "1" "cen" "_ltype" "center" "cen" "")        (command "_.layer" "thaw" "cen" "on" "cen" "unlock" "cen" "")    ) ;------------------------------------------------------------------------------------------         (while (setq a1 (entsel "\n请选定要画中心线的圆\\圆弧\\直线:"))      (setq a2 (entget (car a1)))      (setq l1 (assoc 0 a2))      (setq l2 (cdr l1))      (if (not (wcmatch l2 "LINE,ARC,CIRCLE"))          (princ "\n所选的不是圆\\圆弧\\直线!")          (progn             (cond ((wcmatch l2 "ARC,CIRCLE")        (setq b1 (cdr (assoc 10 a2)))  ;圆心座标                      (setq b2 (cdr (assoc 40 a2)))  ;圆半径                      (setvar "clayer" "cen")                      (command "line" (list (- (car b1) (* b2 1.2)) (cadr b1)) (strcat "@" (rtos (* b2 2.4))                           "<0") "")                      (command "array" (entlast) "" "p" b1 "2" "90" "")     )     ((= l2 "LINE")                       (while (not (setq a3 (entsel "\n请选定另一直线:")))                          (princ "\n没有选定另一直线!")                       )         (setq a4 (entget (car a3)))                       (setq end1 (cdr (assoc 10 a2)))                       (setq end2 (cdr (assoc 11 a2)))                       (setq end3 (cdr (assoc 10 a4)))                       (setq end4 (cdr (assoc 11 a4)))                       (setq e1 (distance end1 end3))                       (setq e2 (distance end1 end4))                       (if (< e1 e2)      (setq end5 (mapcar '* '(0.5 0.5) (mapcar '+ end1 end3))     end6 (mapcar '* '(0.5 0.5) (mapcar '+ end2 end4))      )      (setq end5 (mapcar '* '(0.5 0.5) (mapcar '+ end1 end4))           end6 (mapcar '* '(0.5 0.5) (mapcar '+ end2 end3))      )                                                   )                       (setq end5_1 (polar end5 (angle end6 end5) 10))                       (setq end6_1 (polar end6 (angle end5 end6) 10))                       (setvar "clayer" "cen")                       (command "line" end5_1 end6_1 "")                           )         )      )   )    )    (setq *error* olderr)    (setvar "osmode" os_old)    (setvar "clayer" cl_old)    (princ) )

fqqc

上面的兄弟,谢谢你的修改,自动捕捉的问题是解决了,\但是我先前设置好的坐标系还是会跑掉啦,能再帮我修改一下吗?谢谢!