请求帮助选择顺走向的线
本帖最后由 434939575 于 2021-11-10 12:46 编辑;;====================
(defun c:tt (/ ang ang:ang0 app i mid n na na1obj p1 p2 pa pa: pb pb:
ss)
;;可以270度
;
(setq jl 0.1) ;
(setq app nil) ;(setq na (car (entsel "pp"))) ;
(setq s (ssget))
(setq na (ssname s 0))
(color na 3)
(setq pa (vlax-curve-getstartpoint na))
(setq pb (vlax-curve-getendpoint na));
;
(setq ang (angle pa pb))
(if (> ang 6) ;处理转弯处,6.28->0
(setq ang (abs (- ang 6)))
)
(setq n 1)
(while (= n 1)
;;=================================================
(setq pt-list (9pt pb jl))
(setq ss (ssget "cp" pt-list))
;;==================================================
;
(repeat (setq i (sslength ss))
(setq na1 (ssname ss (setq i (1- i))))
;;==============
(setq pa: (vlax-curve-getstartpoint na1))
(setq pb: (vlax-curve-getendpoint na1))
;;---
(if (equal pb pa: 0.1)
(progn (setq p1 pa:) (setq p2 pb:))
(progn (setq p1 pb:) (setq p2 pa:))
)
;;======================
(setq ang: (angle p1 p2))
(setq obj (vlax-ename->vla-object na1))
(setq ang0 (vla-get-angle obj))
;;=====================
(if (> ang: 6) ;处理转弯处,6.28->0
;
(setq ang: 0)
)
;;==================
;;==================
(if (or (equal ang ang: 0.4);
(> (abs (- ang: ang)) 5.5) ;
;
)
(progn (color na1 6)
(setq n 1)
(setq ang ang:)
(setq pb p2)
)
(progn (setq n 0) ;
)
)
) ;
;;==============
) ;while
; ;
; ;repeat
)
(defun 9pt (pt dis / ang app ii pt1)
(setq app ())
(setq ii 0)
(setq ang 0)
(repeat 9
(setq pt1 (polar pt ang dis))
(setq app (cons pt1 app))
(setq ang (+ ang (* 0.25 pi)))
(setq ii (1+ ii))
) ;repeat
app
)
(defun color (na i /)
(vla-put-color (vlax-ename->vla-object na) i)
)
;
;
请修改下，按线走向选择此线，边上有其他线在此线交点处相交，外边杂线不变色 原线其他软件转过来的，下面连接后炸开，效果好些，干扰没处理好，请大师指导.
页:
[1]