[日积月累]：调整直线为水平垂直！！

eachy

2. 
   
3. ;调整直线为水平垂直
   
4. (defun c:test (/ ss ssl e sp elst ep v)
   
5.   (if (setq ss (ssget ":L" '((0 . "line"))))
   
6.     (progn
   
7.       (setq ssl (sslength ss))
   
8.       (while (> ssl 0)
   
9.         (setq e           (ssname ss (setq ssl (1- ssl)))
   
10.               elst (entget e)
    
11.         )
    
12.         (setq sp (vlax-curve-getstartpoint e)
    
13.               ep (vlax-curve-getendpoint e)
    
14.               v         (mapcar 'abs (mapcar '- sp ep))
    
15.         )
    
16.         (if (not (equal v '(0. 0. 0.) 1e-5))
    
17.           (progn
    
18.             (if        (> (cadr v) (car v))        ; 竖线
    
19.               (if (> (cadr sp) (cadr ep))
    
20.                 (setq
    
21.                   elst (subst (cons 11 (list (car sp) (cadr ep) 0.))
    
22.                               (assoc 11 elst)
    
23.                               elst
    
24.                        )
    
25.                 )
    
26.                 (setq
    
27.                   elst (subst (cons 10 (list (car ep) (cadr sp) 0.))
    
28.                               (assoc 10 elst)
    
29.                               elst
    
30.                        )
    
31.                 )
    
32.               );if
    
33.               (if (> (car sp) (car ep))        ; 竖线
    
34.                 (setq
    
35.                   elst (subst (cons 10 (list (car sp) (cadr ep) 0.))
    
36.                               (assoc 10 elst)
    
37.                               elst
    
38.                        )
    
39.                 )
    
40.                 (setq
    
41.                   elst (subst (cons 11 (list (car ep) (cadr sp) 0.))
    
42.                               (assoc 11 elst)
    
43.                               elst
    
44.                        )
    
45.                 )
    
46.               );if
    
47.             );if
    
48.             (entmod elst)
    
49.           );progn
    
50.         )                                ;if
    
51.       )                                        ;while
    
52.     )
    
53.   )
    
54.   (princ)
    
55. )
    
56. 
    

<br /> ;调整直线为水平垂直<br /> (defun c:test (/ ss ssl e sp elst ep v)<br />   (if (setq ss (ssget ":L" '((0 . "line"))))<br />     (progn<br />       (setq ssl (sslength ss))<br />       (while (> ssl 0)<br />         (setq e           (ssname ss (setq ssl (1- ssl)))<br />               elst (entget e)<br />         )<br />         (setq sp (vlax-curve-getstartpoint e)<br />               ep (vlax-curve-getendpoint e)<br />               v         (mapcar 'abs (mapcar '- sp ep))<br />         )<br />         (if (not (equal v '(0. 0. 0.) 1e-5))<br />           (progn<br />             (if        (> (cadr v) (car v))        ; 竖线<br />               (if (> (cadr sp) (cadr ep))<br />                 (setq<br />                   elst (subst (cons 11 (list (car sp) (cadr ep) 0.))<br />                               (assoc 11 elst)<br />                               elst<br />                        )<br />                 )<br />                 (setq<br />                   elst (subst (cons 10 (list (car ep) (cadr sp) 0.))<br />                               (assoc 10 elst)<br />                               elst<br />                        )<br />                 )<br />               );if<br />               (if (> (car sp) (car ep))        ; 竖线<br />                 (setq<br />                   elst (subst (cons 10 (list (car sp) (cadr ep) 0.))<br />                               (assoc 10 elst)<br />                               elst<br />                        )<br />                 )<br />                 (setq<br />                   elst (subst (cons 11 (list (car ep) (cadr sp) 0.))<br />                               (assoc 11 elst)<br />                               elst<br />                        )<br />                 )<br />               );if<br />             );if<br />             (entmod elst)<br />           );progn<br />         )                                ;if<br />       )                                        ;while<br />     )<br />   )<br />   (princ)<br /> )<br /> <br />

陌生人

为什么不能就以dxf10为准来处理？
实际画图中，真正准确的点可能是起始点，也可能是终点，这么处理后也无法确保调整后就一定是我们希望的点。

eachy

最初由 陌生人 发布
[B]为什么不能就以dxf10为准来处理？
实际画图中，真正准确的点可能是起始点，也可能是终点，这么处理后也无法确保调整后就一定是我们希望的点。 [/B]

这个程序是调整一个表格的时候临时写的，只为完成一个功能，谈不上完善。水平线以左边为基准，竖线以上面为基准。

wkai

这个程序我想是用来修正那些有轻微偏差的准水平或者准垂直线，因此用那边当基准点，对图形的影响都不大。

cy956

俺们用的是归精度（按一个精度向最近点靠）

wkai

我试了一下，提点建议。
最好能够提示输入一个角度，和水平垂直相差在这个之内的直线，归于水平垂直，其他的不变。
比如输入 5 ，则 0 加减 5 之间的归于水平，则 90 加减 5 之间的归于垂直。

陌生人

和我想的一样，我写了一个，不过现在不在家。：s

eachy

最初由 陌生人 发布
[B]和我想的一样，我写了一个，不过现在不在家。：s [/B]

期待你的完整程序，我是就事写的不考虑那么多。在发一个日积月累

2. 
   
3. (defun test (lay /)
   
4.   (vlax-map-collection
   
5.     (vlax-get (vlax-get (vlax-get-acad-object) 'activedocument)
   
6.               'blocks
   
7.     )
   
8.     '(lambda (i)
   
9.        (vlax-map-collection
   
10.          i
    
11.          '(lambda (x) (vla-put-layer x lay))
    
12.        )
    
13.      )
    
14.   )
    
15.   (princ)
    
16. )
    

<br /> (defun test (lay /)<br />   (vlax-map-collection<br />     (vlax-get (vlax-get (vlax-get-acad-object) 'activedocument)<br />               'blocks<br />     )<br />     '(lambda (i)<br />        (vlax-map-collection<br />          i<br />          '(lambda (x) (vla-put-layer x lay))<br />        )<br />      )<br />   )<br />   (princ)<br /> )<br />

xgwl

我觉得还是加一个基准点来调整比较好,比如点取实体时最近一个端点或交点为基准点!

陌生人

回楼上：很多时候是取选集而不是点选.
回应ea斑竹，发一个支持角度容差的.

2. 
   
3. ;hvline = 自动调整水平垂直.------------------陌生人.2004.6
   
4. ;******主测程序******
   
5. (defun c:hvline (/ i li ang)
   
6.   (vl-cmdf ".undo" "be")
   
7.   (setq ang (getdist "\n容差度数:"))
   
8.   (while (progn (princ "\n选择需要调整水平垂直的直线/<退出>:")(setq ss (ssget ":L" '((0 . "LINE")))))
   
9.     (setq i -1)
   
10.     (while (setq li (ssname ss (setq i (1+ i))))
    
11.       (xli-hv li (* (/ ang 180) PI)) ;1度.
    
12.     )
    
13.   )
    
14.   (vl-cmdf ".undo" "e")
    
15.   (princ)
    
16. )
    
17. ;********* (xli-hv) 核心函数 ********
    
18. ;v1.1,按angf角度容差处理.调整均以起始点dxf10为准.
    
19. (defun xli-hv (li angf / sp ep ang lst ent)
    
20.   (setq sp (vlax-curve-getstartpoint li)
    
21.         ep (vlax-curve-getendpoint li)
    
22.         ang (angle sp ep))
    
23.   (cond
    
24.     ((or (equal ang 0 angf)(equal ang (* 2 PI) angf)(equal ang PI angf)) ;基本水平.
    
25.      (setq lst (list (car ep)(cadr sp)(caddr sp))))
    
26.     ((or (equal ang (* 0.5 PI) angf)(equal ang (* 1.5 PI) angf)) ;基本垂直(水平已经过滤).
    
27.      (setq lst (list (car sp)(cadr ep)(caddr sp))))
    
28.   )
    
29.   (if lst
    
30.       (progn (setq ent (entget li))
    
31.         (entmod (subst (cons 11 lst)(assoc 11 ent)ent))
    
32.       )
    
33.   )(princ)
    
34. )
    

<br /> ;hvline = 自动调整水平垂直.------------------陌生人.2004.6 <br /> ;******主测程序******<br /> (defun c:hvline (/ i li ang)<br />   (vl-cmdf ".undo" "be")<br />   (setq ang (getdist "\n容差度数:"))<br />   (while (progn (princ "\n选择需要调整水平垂直的直线/<退出>:")(setq ss (ssget ":L" '((0 . "LINE")))))<br />     (setq i -1)<br />     (while (setq li (ssname ss (setq i (1+ i))))<br />       (xli-hv li (* (/ ang 180) PI)) ;1度.<br />     )<br />   )<br />   (vl-cmdf ".undo" "e")<br />   (princ)<br /> )<br /> ;********* (xli-hv) 核心函数 ********<br /> ;v1.1,按angf角度容差处理.调整均以起始点dxf10为准.<br /> (defun xli-hv (li angf / sp ep ang lst ent)<br />   (setq sp (vlax-curve-getstartpoint li)<br />         ep (vlax-curve-getendpoint li)<br />         ang (angle sp ep))<br />   (cond<br />     ((or (equal ang 0 angf)(equal ang (* 2 PI) angf)(equal ang PI angf)) ;基本水平.<br />      (setq lst (list (car ep)(cadr sp)(caddr sp))))<br />     ((or (equal ang (* 0.5 PI) angf)(equal ang (* 1.5 PI) angf)) ;基本垂直(水平已经过滤).<br />      (setq lst (list (car sp)(cadr ep)(caddr sp))))<br />   )<br />   (if lst<br />       (progn (setq ent (entget li))<br />         (entmod (subst (cons 11 lst)(assoc 11 ent)ent))<br />       )<br />   )(princ)<br /> )<br />