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

qd001

有没有可以实现图纸里直线与直线垂直和水平关系检查功能的，框选2条或以上直线，判断一条或者多条直线是垂直或者水平，对于不是垂直或者水平的，倾斜的直线修改其颜色特别显示

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 /> )

llsheng_73

垂直是两条线的关系，一条直线只有正交（竖直或水平）和非正交（倾斜)
计算直线起点和止点的坐标或坐标差
(setq dxy(mapcar'- p1 p2'(0 0)))
(cond((equal(car dxy)0 1e-8)"竖直")((equal(cadr dxy)0 1e-8)"水平")(T"倾斜"))
或
(setq dxy(mapcar(function(lambda(a b)(equal a b 1e-8)))p1(mapcar'+ p2'(0 0))))
(if(apply'or dxy)"正交""倾斜")
或(if(car dxy)"竖直"(if(cadr dxy)"水平""倾斜"))

1. (defun c:tt(/ s e en);;;倾斜直线改为红色
   
2.   (and(setq s(ssget'((0 . "line"))))
   
3.       (repeat(sslength s)
   
4.         (setq e(ssname s 0)en(entget e))
   
5.         (or(vl-some(function(lambda(a b)(equal a b 1e-8)))(cdr(assoc 10 en))(mapcar'+'(0 0)(cdr(assoc 11 en))))
   
6.            (entmod(append en'((62 . 1)))))
   
7.         (ssdel e s))))

(defun c:tt(/ s e en);;;倾斜直线改为红色<br />   (and(setq s(ssget'((0 . "line"))))<br />       (repeat(sslength s)<br />         (setq e(ssname s 0)en(entget e))<br />         (or(vl-some(function(lambda(a b)(equal a b 1e-8)))(cdr(assoc 10 en))(mapcar'+'(0 0)(cdr(assoc 11 en))))<br />            (entmod(append en'((62 . 1)))))<br />         (ssdel e s))))

如果当时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 /> )

你有种再说一遍

让我想起来高版本的直线上下差0.1是看不出来的,
而低版本可以看到折了一下

自贡黄明儒

用inters 可以判断

帝都划水王

属性看始终点坐标？

gzcsun

你有种再说一遍 发表于 2024-11-18 00:24
让我想起来高版本的直线上下差0.1是看不出来的,
而低版本可以看到折了一下

是因为低版本显示差，高版本设置显示差时一样可以看到折了。

你有种再说一遍

gzcsun 发表于 2024-11-18 10:41
是因为低版本显示差，高版本设置显示差时一样可以看到折了。

不觉得这是显示策略的不同而已嘛?
为什么你总会想到差不差的点上面,而且不觉得影响用户才是差吗

如果当时0809

用两直线单位向量叉乘可以判断平行和垂直，绝对值等于0是平行，绝对值等于1是垂直

qd001

如果当时0809 发表于 2024-11-19 09:43
用两直线单位向量叉乘可以判断平行和垂直，绝对值等于0是平行，绝对值等于1是垂直

怎么写代码，可以判断图纸里面所有的直线么

qd001

llsheng_73 发表于 2024-11-18 11:23
垂直是两条线的关系，一条直线只有正交（竖直或水平）和非正交（倾斜)
计算直线起点和止点的坐标或坐标 ...

怎么写代码，可以判断图纸里面所有的直线么，找出不是水平和垂直的就是倾斜的直线并着色显示