一条或者多条直线是垂直或者水平，对于不是垂直或者水平的，倾斜的直线修改其颜色

如果当时0809

qd001 发表于 2024-11-19 14:19
怎么写代码，可以判断图纸里面所有的直线么

1. (defun c:tt (/ l1 l2 a1 a2 a)
   
2.   (setq l1 (entget (car (entsel "\n选择第一根线:"))))
   
3.   (setq l2 (entget (car (entsel "\n选择第二根线:\n"))))
   
4.   ;计算第一条直线角度
   
5.   (setq a1 (angle (cdr (assoc 10 l1)) (cdr (assoc 11 l1))))
   
6.   ;计算第二条直线角度
   
7.   (setq a2 (angle (cdr (assoc 10 l2)) (cdr (assoc 11 l2))))
   
8.   ;计算第夹条直线角度
   
9.   (setq a (abs (- a1 a2)))
   
10.   ;判断夹角等于0,pi/2还是pi
    
11.   (cond
    
12.     ((equal a 0 1e-6) (princ "两直线平行"))
    
13.     ((equal a (/ PI 2) 1e-6) (princ "两直线垂直"))
    
14.     ((equal a PI 1e-6) (princ "两直线平行"))
    
15.     (T (princ "两直线不平行也不垂直"))
    
16.   )
    
17.   (princ)
    
18. )

(defun c:tt (/ l1 l2 a1 a2 a) <br />   (setq l1 (entget (car (entsel "\n选择第一根线:"))))<br />   (setq l2 (entget (car (entsel "\n选择第二根线:\n"))))<br />   ;计算第一条直线角度<br />   (setq a1 (angle (cdr (assoc 10 l1)) (cdr (assoc 11 l1))))<br />   ;计算第二条直线角度<br />   (setq a2 (angle (cdr (assoc 10 l2)) (cdr (assoc 11 l2))))<br />   ;计算第夹条直线角度<br />   (setq a (abs (- a1 a2)))<br />   ;判断夹角等于0,pi/2还是pi<br />   (cond <br />     ((equal a 0 1e-6) (princ "两直线平行"))<br />     ((equal a (/ PI 2) 1e-6) (princ "两直线垂直"))<br />     ((equal a PI 1e-6) (princ "两直线平行"))<br />     (T (princ "两直线不平行也不垂直"))<br />   )<br />   (princ)<br /> )

qd001

如果当时0809 发表于 2024-11-19 15:39

感谢可以框选两条直线么，或是框选更多直线，找出不是垂直和水平的直线，就是倾斜的直线，着色显示

如果当时0809

qd001 发表于 2024-11-19 16:08
感谢可以框选两条直线么，或是框选更多直线，找出不是垂直和水平的直线，就是倾斜的直线，着色显示

那你的问题应该改成判断一条或者多条直线是垂直或者水平，对于不是垂直或者水平的，修改其颜色。

qd001

如果当时0809 发表于 2024-11-19 16:13
那你的问题应该改成判断一条或者多条直线是垂直或者水平，对于不是垂直或者水平的，修改其颜色。

标题我更新了

如果当时0809

qd001 发表于 2024-11-19 16:19
标题我更新了

对于垂直和水平的线不处理，其他线改为红色

1. (defun c:tt (/ ls l n a)
   
2.   (setq ls (ssget (list (cons 0 "LINE"))))
   
3.   (if (null ls) (exit))
   
4.   (setq n 0)
   
5.   (repeat (sslength ls)
   
6.     (setq l (entget (ssname ls n)))
   
7.     (setq a (angle (cdr (assoc 10 l)) (cdr (assoc 11 l))))
   
8.     (cond
   
9.       ((equal a 0 1e-6) (princ))
   
10.       ((equal a (/ PI 2) 1e-6) (princ))
    
11.       ((equal a PI 1e-6) (princ))
    
12.       ((equal a (/ (* PI 3) 2) 1e-6) (princ))
    
13.       (T
    
14.        (if (assoc 62 l)
    
15.          (entmod (subst (cons 62 1) (assoc 62 l) l))
    
16.          (entmod (append l (list (cons 62 1))))
    
17.        )
    
18.       )
    
19.     )
    
20.     (setq n (1+ n))
    
21.   )
    
22.   (princ)
    
23. )

(defun c:tt (/ ls l n a) <br />   (setq ls (ssget (list (cons 0 "LINE"))))<br />   (if (null ls) (exit))<br />   (setq n 0)<br />   (repeat (sslength ls) <br />     (setq l (entget (ssname ls n)))<br />     (setq a (angle (cdr (assoc 10 l)) (cdr (assoc 11 l))))<br />     (cond <br />       ((equal a 0 1e-6) (princ))<br />       ((equal a (/ PI 2) 1e-6) (princ))<br />       ((equal a PI 1e-6) (princ))<br />       ((equal a (/ (* PI 3) 2) 1e-6) (princ))<br />       (T<br />        (if (assoc 62 l) <br />          (entmod (subst (cons 62 1) (assoc 62 l) l))<br />          (entmod (append l (list (cons 62 1))))<br />        )<br />       )<br />     )<br />     (setq n (1+ n))<br />   )<br />   (princ)<br /> )

qd001

如果当时0809 发表于 2024-11-19 16:25
对于垂直和水平的线不处理，其他线改为红色

感谢，可以实现

qd001

如果当时0809 发表于 2024-11-19 16:25
对于垂直和水平的线不处理，其他线改为红色

倾斜的多线段可以检查出来么

qd001

如果当时0809 发表于 2024-11-19 16:25
对于垂直和水平的线不处理，其他线改为红色

可以加上倾斜的多线段么

lht

提取线的起、终点坐标，如果起、终点X相等就是垂直的，如果起、终点Y相等就是水平的，都不相等就是倾斜的。

xyp1964

1. (defun c:tt ()
   
2.   (defun xyp-dxf (code e) (cdr (assoc code (entget e))))
   
3.   (setq i -1)
   
4.   (if (setq ss (ssget '((0 . "LINE"))))
   
5.     (while (setq s1 (ssname ss (setq i (1+ i))))
   
6.       (setq p1 (xyp-DXF 10 s1)
   
7.             p2 (xyp-DXF 11 s1)
   
8.       )
   
9.       (if (not(or (equal (car p1) (car p2)) (equal (cadr p1) (cadr p2))))
   
10.         (vla-put-color (vlax-ename->vla-object s1) 1)
    
11.       )
    
12.     )
    
13.   )
    
14.   (princ)
    
15. )

(defun c:tt ()<br />   (defun xyp-dxf (code e) (cdr (assoc code (entget e))))<br />   (setq i -1)<br />   (if (setq ss (ssget '((0 . "LINE"))))<br />     (while (setq s1 (ssname ss (setq i (1+ i))))<br />       (setq p1 (xyp-DXF 10 s1)<br />             p2 (xyp-DXF 11 s1)<br />       )<br />       (if (not(or (equal (car p1) (car p2)) (equal (cadr p1) (cadr p2))))<br />         (vla-put-color (vlax-ename->vla-object s1) 1)<br />       )<br />     )<br />   )<br />   (princ)<br /> )

1. (defun c:tt ()
   
2.   (setq i -1)
   
3.   (if (setq ss (ssget '((0 . "LINE"))))
   
4.     (while (setq s1 (ssname ss (setq i (1+ i))))
   
5.       (setq s (vlax-curve-getStartPoint s1)
   
6.             e (vlax-curve-getEndPoint s1)
   
7.       )
   
8.       (if (not (or (equal (car s) (car e)1e-3) (equal (cadr s) (cadr e)1e-3)))
   
9.         (vla-put-color (vlax-ename->vla-object s1) 1)
   
10.       )
    
11.     )
    
12.   )
    
13.   (princ)
    
14. )

(defun c:tt ()<br />   (setq i -1)<br />   (if (setq ss (ssget '((0 . "LINE"))))<br />     (while (setq s1 (ssname ss (setq i (1+ i))))<br />       (setq s (vlax-curve-getStartPoint s1)<br />             e (vlax-curve-getEndPoint s1)<br />       )<br />       (if (not (or (equal (car s) (car e)1e-3) (equal (cadr s) (cadr e)1e-3)))<br />         (vla-put-color (vlax-ename->vla-object s1) 1)<br />       )<br />     )<br />   )<br />   (princ)<br /> )