qd001 发表于 2024-11-19 14:19
怎么写代码，可以判断图纸里面所有的直线么
(defun c:tt (/ l1 l2 a1 a2 a)
(setq l1 (entget (car (entsel "\n选择第一根线:"))))
(setq l2 (entget (car (entsel "\n选择第二根线:\n"))))
;计算第一条直线角度
(setq a1 (angle (cdr (assoc 10 l1)) (cdr (assoc 11 l1))))
;计算第二条直线角度
(setq a2 (angle (cdr (assoc 10 l2)) (cdr (assoc 11 l2))))
;计算第夹条直线角度
(setq a (abs (- a1 a2)))
;判断夹角等于0,pi/2还是pi
(cond
((equal a 0 1e-6) (princ "两直线平行"))
((equal a (/ PI 2) 1e-6) (princ "两直线垂直"))
((equal a PI 1e-6) (princ "两直线平行"))
(T (princ "两直线不平行也不垂直"))
)
(princ)
)
如果当时0809 发表于 2024-11-19 15:39
感谢可以框选两条直线么，或是框选更多直线，找出不是垂直和水平的直线，就是倾斜的直线，着色显示
qd001 发表于 2024-11-19 16:08
感谢可以框选两条直线么，或是框选更多直线，找出不是垂直和水平的直线，就是倾斜的直线，着色显示
那你的问题应该改成判断一条或者多条直线是垂直或者水平，对于不是垂直或者水平的，修改其颜色。
如果当时0809 发表于 2024-11-19 16:13
那你的问题应该改成判断一条或者多条直线是垂直或者水平，对于不是垂直或者水平的，修改其颜色。
标题我更新了{:1_1:}
qd001 发表于 2024-11-19 16:19
标题我更新了
对于垂直和水平的线不处理，其他线改为红色
(defun c:tt (/ ls l n a)
(setq ls (ssget (list (cons 0 "LINE"))))
(if (null ls) (exit))
(setq n 0)
(repeat (sslength ls)
(setq l (entget (ssname ls n)))
(setq a (angle (cdr (assoc 10 l)) (cdr (assoc 11 l))))
(cond
((equal a 0 1e-6) (princ))
((equal a (/ PI 2) 1e-6) (princ))
((equal a PI 1e-6) (princ))
((equal a (/ (* PI 3) 2) 1e-6) (princ))
(T
(if (assoc 62 l)
(entmod (subst (cons 62 1) (assoc 62 l) l))
(entmod (append l (list (cons 62 1))))
)
)
)
(setq n (1+ n))
)
(princ)
)
如果当时0809 发表于 2024-11-19 16:25
对于垂直和水平的线不处理，其他线改为红色
感谢，可以实现
如果当时0809 发表于 2024-11-19 16:25
对于垂直和水平的线不处理，其他线改为红色
倾斜的多线段可以检查出来么:Q-
如果当时0809 发表于 2024-11-19 16:25
对于垂直和水平的线不处理，其他线改为红色
可以加上倾斜的多线段么:Q-
本帖最后由 lht 于 2024-11-19 19:27 编辑
提取线的起、终点坐标，如果起、终点X相等就是垂直的，如果起、终点Y相等就是水平的，都不相等就是倾斜的。
本帖最后由 xyp1964 于 2024-11-19 22:27 编辑
(defun c:tt ()
(defun xyp-dxf (code e) (cdr (assoc code (entget e))))
(setq i -1)
(if (setq ss (ssget '((0 . "LINE"))))
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq p1 (xyp-DXF 10 s1)
p2 (xyp-DXF 11 s1)
)
(if (not(or (equal (car p1) (car p2)) (equal (cadr p1) (cadr p2))))
(vla-put-color (vlax-ename->vla-object s1) 1)
)
)
)
(princ)
)
(defun c:tt ()
(setq i -1)
(if (setq ss (ssget '((0 . "LINE"))))
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq s (vlax-curve-getStartPoint s1)
e (vlax-curve-getEndPoint s1)
)
(if (not (or (equal (car s) (car e)1e-3) (equal (cadr s) (cadr e)1e-3)))
(vla-put-color (vlax-ename->vla-object s1) 1)
)
)
)
(princ)
)