[编程申请]：求LSP程序，强迫直线LINE水平或垂直

lengliqun

求LSP程序，强迫直线LINE水平或垂直。如果直线LINE与X轴夹角小于1度，强迫该直线与X轴完全平行；
如果直线LINE与Y轴夹角小于1度，强迫该直线与Y轴完全平行,谢谢。这样可以美化图面，消除手工作图不
小心产生的误差。

它山之石

正交

lengliqun

我知有cad有正交功能，可有些人(包括我)某个时候一不小心，产生了小小扁差，导致某些专业外挂命令不能正常使用。期待高手出招。

eachy

2. 
   
3. (defun c:tt (/ p1 p2 ss e ssl sp ep)
   
4.   (if (setq ss (ssget '((0 . "line"))))
   
5.     (progn
   
6.       (setq ssl (sslength ss))
   
7.       (while (> ssl 0)
   
8.         (setq e         (ssname ss (setq ssl (1- ssl)))
   
9.               el (entget e)
   
10.         )
    
11.         (setq sp (cdr (assoc 10 el))
    
12.               ep (cdr (assoc  11 el))
    
13.               an (angle sp ep)
    
14.         )
    
15.         (cond
    
16.           ((or (equal an 0.0 0.01);_0.01 弧度，自己设定
    
17.                (equal an pi 0.01)
    
18.            )
    
19.            (entmod (subst (cons 11 (list (car ep) (cadr sp) (last ep)))
    
20.                           (assoc 11 el)
    
21.                           el
    
22.                    )
    
23.            )
    
24.           )
    
25.           ((or (equal an (/ pi 2) 0.01)
    
26.                (equal an (* 1.5 pi) 0.01)
    
27.            )
    
28.            (entmod (subst (cons 11 (list (car sp) (cadr ep) (last ep)))
    
29.                           (assoc 11 el)
    
30.                           el
    
31.                    )
    
32.            )
    
33.           )
    
34.           (t)
    
35.         )
    
36.       )
    
37.     )
    
38.   )
    
39.   (princ)
    
40. )

<br /> (defun c:tt (/ p1 p2 ss e ssl sp ep)<br />   (if (setq ss (ssget '((0 . "line"))))<br />     (progn<br />       (setq ssl (sslength ss))<br />       (while (> ssl 0)<br />         (setq e         (ssname ss (setq ssl (1- ssl)))<br />               el (entget e)<br />         )<br />         (setq sp (cdr (assoc 10 el))<br />               ep (cdr (assoc  11 el))<br />               an (angle sp ep)<br />         )<br />         (cond<br />           ((or (equal an 0.0 0.01);_0.01 弧度，自己设定<br />                (equal an pi 0.01)<br />            )<br />            (entmod (subst (cons 11 (list (car ep) (cadr sp) (last ep)))<br />                           (assoc 11 el)<br />                           el<br />                    )<br />            )<br />           )<br />           ((or (equal an (/ pi 2) 0.01)<br />                (equal an (* 1.5 pi) 0.01)<br />            )<br />            (entmod (subst (cons 11 (list (car sp) (cadr ep) (last ep)))<br />                           (assoc 11 el)<br />                           el<br />                    )<br />            )<br />           )<br />           (t)<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

lengliqun

经测试，非常好用，谢谢。

它山之石

不好意思，俺误解了你的意思了。
你要的是将画好的直线变为水平或垂直。俺还以为是画线时要那样呢。
平时确实有这个问题。楼主的主意不错。
斑主的程序也很好用。
谢谢。

狂刀

[php]
;|vh = 校正水平,垂直直线 |;
(defun c:vh ( / ss d i ent p10 p11)
  (princ "\n校正水平,垂直直线")
  (if (and (setq i -1 ss (ssget '((0 . "LINE"))))
           (setq d  (getdist "\n误差值:")))
    (while (setq e (ssname ss (setq i (1+ i))))
      (setq ent (entget e )
            p10 (cdr(assoc 10 ent))
            p11 (cdr(assoc 11 ent)))
      (cond
        ((equal (car p10)(car p11) d)
         (entmod(subst (cons 11 (list(car p10)(cadr p11)))(assoc 11 ent)ent)))
        ((equal (cadr p10)(cadr p11) d)
          (entmod(subst (cons 11 (list(car p11)(cadr p10)))(assoc 11 ent)ent)))
        (T nil)
      )
    )
  )(princ)
)[/php]

lengliqun

经测试7楼楼主之程序可用，谢谢。

li809

用shift键就可以实现了

狂刀

你是说画的时候吧?现在是说画完了之后怎么改

huiling6868

7楼楼主选择物体后,误差输入什么?

应该是角度。by xyp1964[/COLOR]

qmx

这个挺好的，感谢楼主的提议

huiling6868

输入角度没反映吗?

狂刀

７楼程序误差值是距离

huiling6868

输入什么距离.