坐标标注对齐运行不稳定，帮忙看看

xiaobao02

最近新编了一个座标标注对齐程序，可根据选择的标注上下左右对齐，全新标注的可以，以前标好的对齐不了，请高手帮忙看看问题出在哪里！
我的思路是先判断选择标注是x,y,-x,-y哪个方向的，然后分别得取各方向最接近原点的X或Y值，最后重新组合一个新座标更新位置！
请帮忙先修正以下代码，如有更好思路也欢迎讨论！谢谢！

(defun c:dj(/ ds1)
  (princ "\n***标注对齐***")

  (setq ds1 (ssget '((0 . "DIMENSION"))))
  
;分类统计X,Y,-x,-y对齐的点
  
    (setq djls11 '())
    (setq djls21 '())
    (setq djls31 '())
    (setq djls41 '())
  

  (setq n 0)
  (repeat (sslength ds1)
    (setq dp11 (cdr (assoc 11 (entget (ssname ds1 n))))) ;标注文字中间点
    (setq dp14 (cdr (assoc 14 (entget (ssname ds1 n))))) ;标注文字边上点
    (setq dan1 (angle dp14 dp11)) ;标注朝向

    (cond
      ((equal dan1 0 0.05)             (setq djls11 (cons (car dp14) djls11)))
      ((equal dan1 (* pi 0.5) 0.05)    (setq djls21 (cons (cadr dp14) djls21)))
      ((equal dan1 pi 0.05)            (setq djls31 (cons (car dp14) djls31)))
      ((equal dan1 (* pi 1.5) 0.05)    (setq djls41 (cons (cadr dp14) djls41)))
      )
    (setq dp11 nil dp14 nil dan1 nil)
    (setq n (1+ n))
   )

  (setq djav1 (apply 'min djls11))  ;X
  (setq djav2 (apply 'min djls21))  ;y
  (setq djav3 (apply 'min djls31))  ;-X
  (setq djav4 (apply 'min djls41))  ;-y

(setq dp11 nil dp14 nil dan1 nil)
(setq djls11 nil djls21 nil djls31 nil djls41 nil)


;根据X,Y,-x,-y的值，重组并更新
  
(setvar 'osmode 0)
(setq n 0)
(repeat (sslength ds1)
    (setq e (ssname ds1 n))
    (setq e1 (entget e))
    (setq dp11 (cdr (assoc 11 e1))) ;标注文字中间点
    (setq dp14 (cdr (assoc 14 e1))) ;标注文字边上点
    (setq dan1 (angle dp14 dp11)) ;标注朝向  
   
   
    (cond
      ((equal dan1 0 0.05)               (setq e1 (subst (cons 14 (list djav1 (cadr dp14) 0)) (assoc 14 e1) e1)))
      ((equal dan1 (* pi 0.5) 0.05)      (setq e1 (subst (cons 14 (list (car dp14) djav2 0)) (assoc 14 e1) e1)))
      ((equal dan1 pi 0.05)              (setq e1 (subst (cons 14 (list djav3 (cadr dp14) 0)) (assoc 14 e1) e1)))
      ((equal dan1 (* pi 1.5) 0.05)      (setq e1 (subst (cons 14 (list (car dp14) djav4 0)) (assoc 14 e1) e1)))
      )
    (entmod e1)
    (entupd e)
    (setq n (1+ n))
   )
   
(setq djav1 nil djav2 nil djav3 nil djav4 nil)
(princ)
)

xiaobao02

问题已找到，困扰了我好多天！主要原因为坐标标注组码14和11是关联的，要动就要一起变更！更新如下，程序运行OK，如有更好方法，欢迎留贴，谢谢！

2. 
   
3. (defun c:dj(/ ds1)
   
4.   (princ "\n***标注对齐***")
   
5. (sta)
   
6.   (setq ds1 (ssget '((0 . "DIMENSION"))))
   
7.   
   
8. ;分类统计X,Y,-x,-y对齐的点
   
9.   
   
10.     (setq djls11 '())
    
11.     (setq djls21 '())
    
12.     (setq djls31 '())
    
13.     (setq djls41 '())
    
14.   
    
15. 
    
16.   (setq n 0)
    
17.   (repeat (sslength ds1)
    
18.     (setq dp11 (cdr (assoc 11 (entget (ssname ds1 n))))) ;标注文字中间点
    
19.     (setq dp14 (cdr (assoc 14 (entget (ssname ds1 n))))) ;标注文字边上点
    
20.     (setq dan1 (angle dp14 dp11)) ;标注朝向
    
21. 
    
22.     (cond
    
23.       ((equal dan1 0 0.05)             (setq djls11 (cons (car dp14) djls11)))
    
24.       ((equal dan1 (* pi 0.5) 0.05)    (setq djls21 (cons (cadr dp14) djls21)))
    
25.       ((equal dan1 pi 0.05)            (setq djls31 (cons (car dp14) djls31)))
    
26.       ((equal dan1 (* pi 1.5) 0.05)    (setq djls41 (cons (cadr dp14) djls41)))
    
27.       )
    
28.     (setq dp11 nil dp14 nil dan1 nil)
    
29.     (setq n (1+ n))
    
30.    )
    
31. 
    
32.   (setq djav1 (apply 'min djls11))  ;X
    
33.   (setq djav2 (apply 'min djls21))  ;y
    
34.   (setq djav3 (apply 'min djls31))  ;-X
    
35.   (setq djav4 (apply 'min djls41))  ;-y
    
36. 
    
37. (setq dp11 nil dp14 nil dan1 nil)
    
38. (setq djls11 nil djls21 nil djls31 nil djls41 nil)
    
39. 
    
40. 
    
41. ;根据X,Y,-x,-y的值，重组并更新
    
42. 
    
43.   (command "ucs" "w")
    
44.   
    
45. (setvar 'osmode 0)
    
46. (setq n 0)
    
47. (repeat (sslength ds1)
    
48.     (setq e (ssname ds1 n))
    
49.     (setq e1 (entget e))
    
50.     (setq dp11 (cdr (assoc 11 e1))) ;标注文字中间点
    
51.     (setq dp14 (cdr (assoc 14 e1))) ;标注文字边上点
    
52.     (setq dan1 (angle dp14 dp11)) ;标注朝向
    
53. 
    
54.     (setq dpa11 (distance dp11 dp14)) ;组码11和14相对距离
    
55.    
    
56.    
    
57.     (cond
    
58.       ((equal dan1 0 0.05)              
    
59.           (setq e1 (subst (cons 14 (list djav1 (cadr dp14) 0)) (assoc 14 e1) e1))
    
60.           (setq e1 (subst (cons 11 (polar (list djav1 (cadr dp14) 0) 0 dpa11)) (assoc 11 e1) e1)))
    
61.       ((equal dan1 (* pi 0.5) 0.05)   
    
62.           (setq e1 (subst (cons 14 (list (car dp14) djav2 0)) (assoc 14 e1) e1))
    
63.           (setq e1 (subst (cons 11 (polar (list (car dp14) djav2 0) (* pi 0.5) dpa11)) (assoc 11 e1) e1)))
    
64.       ((equal dan1 pi 0.05)            
    
65.           (setq e1 (subst (cons 14 (list djav3 (cadr dp14) 0)) (assoc 14 e1) e1))
    
66.            (setq e1 (subst (cons 11 (polar (list djav3 (cadr dp14) 0) pi dpa11)) (assoc 11 e1) e1)))
    
67.       ((equal dan1 (* pi 1.5) 0.05)   
    
68.             (setq e1 (subst (cons 14 (list (car dp14) djav4 0)) (assoc 14 e1) e1))
    
69.             (setq e1 (subst (cons 11 (polar (list (car dp14) djav4 0) (* pi 1.5) dpa11)) (assoc 11 e1) e1)))
    
70.       )
    
71.     (entmod e1)
    
72.    (setq dp11 nil dp14 nil dan1 nil dpa11 nil)
    
73.         (setq n (1+ n))
    
74.    )
    
75.    (entupd e)
    
76. (setq djav1 nil djav2 nil djav3 nil djav4 nil)
    
77. (end)
    
78. (princ)
    
79. )

<br /> (defun c:dj(/ ds1)<br />   (princ "\n***标注对齐***")<br /> (sta)<br />   (setq ds1 (ssget '((0 . "DIMENSION"))))<br />   <br /> ;分类统计X,Y,-x,-y对齐的点<br />   <br />     (setq djls11 '())<br />     (setq djls21 '())<br />     (setq djls31 '())<br />     (setq djls41 '())<br />   <br /> <br />   (setq n 0)<br />   (repeat (sslength ds1)<br />     (setq dp11 (cdr (assoc 11 (entget (ssname ds1 n))))) ;标注文字中间点<br />     (setq dp14 (cdr (assoc 14 (entget (ssname ds1 n))))) ;标注文字边上点<br />     (setq dan1 (angle dp14 dp11)) ;标注朝向<br /> <br />     (cond<br />       ((equal dan1 0 0.05)             (setq djls11 (cons (car dp14) djls11)))<br />       ((equal dan1 (* pi 0.5) 0.05)    (setq djls21 (cons (cadr dp14) djls21)))<br />       ((equal dan1 pi 0.05)            (setq djls31 (cons (car dp14) djls31)))<br />       ((equal dan1 (* pi 1.5) 0.05)    (setq djls41 (cons (cadr dp14) djls41)))<br />       )<br />     (setq dp11 nil dp14 nil dan1 nil) <br />     (setq n (1+ n))<br />    )<br /> <br />   (setq djav1 (apply 'min djls11))  ;X<br />   (setq djav2 (apply 'min djls21))  ;y<br />   (setq djav3 (apply 'min djls31))  ;-X<br />   (setq djav4 (apply 'min djls41))  ;-y<br /> <br /> (setq dp11 nil dp14 nil dan1 nil) <br /> (setq djls11 nil djls21 nil djls31 nil djls41 nil)<br /> <br /> <br /> ;根据X,Y,-x,-y的值，重组并更新<br /> <br />   (command "ucs" "w")<br />   <br /> (setvar 'osmode 0)<br /> (setq n 0)<br /> (repeat (sslength ds1)<br />     (setq e (ssname ds1 n))<br />     (setq e1 (entget e))<br />     (setq dp11 (cdr (assoc 11 e1))) ;标注文字中间点<br />     (setq dp14 (cdr (assoc 14 e1))) ;标注文字边上点<br />     (setq dan1 (angle dp14 dp11)) ;标注朝向<br /> <br />     (setq dpa11 (distance dp11 dp14)) ;组码11和14相对距离<br />     <br />     <br />     (cond<br />       ((equal dan1 0 0.05)              <br />           (setq e1 (subst (cons 14 (list djav1 (cadr dp14) 0)) (assoc 14 e1) e1))<br />           (setq e1 (subst (cons 11 (polar (list djav1 (cadr dp14) 0) 0 dpa11)) (assoc 11 e1) e1)))<br />       ((equal dan1 (* pi 0.5) 0.05)   <br />           (setq e1 (subst (cons 14 (list (car dp14) djav2 0)) (assoc 14 e1) e1))<br />           (setq e1 (subst (cons 11 (polar (list (car dp14) djav2 0) (* pi 0.5) dpa11)) (assoc 11 e1) e1)))<br />       ((equal dan1 pi 0.05)            <br />           (setq e1 (subst (cons 14 (list djav3 (cadr dp14) 0)) (assoc 14 e1) e1))<br />            (setq e1 (subst (cons 11 (polar (list djav3 (cadr dp14) 0) pi dpa11)) (assoc 11 e1) e1)))<br />       ((equal dan1 (* pi 1.5) 0.05)    <br />             (setq e1 (subst (cons 14 (list (car dp14) djav4 0)) (assoc 14 e1) e1))<br />             (setq e1 (subst (cons 11 (polar (list (car dp14) djav4 0) (* pi 1.5) dpa11)) (assoc 11 e1) e1)))<br />       )<br />     (entmod e1)<br />    (setq dp11 nil dp14 nil dan1 nil dpa11 nil)<br />         (setq n (1+ n))<br />    )<br />    (entupd e)<br /> (setq djav1 nil djav2 nil djav3 nil djav4 nil)<br /> (end)<br /> (princ)<br /> )

328302216

楼主   (sta)  和(end)  是什么内容  没这两个执行没报错但是也没看到有什么反应……  希望楼主把那两个子程序还是什么的源码加上   

xiaobao02

328302216 发表于 2013-4-1 11:49
楼主   (sta)  和(end)  是什么内容  没这两个执行没报错但是也没看到有什么反应……  希望楼主把那两个子程 ...

没用，删掉就好，记忆恢复捕捉状态的！