两共线直线连成一条

sunny_8848 · 发表于 2020-9-15 09:18:09

如题，许多直线共线，但端点不一定重合，原两线最外端端点连成一直线并删除原来的直线，至少类似的能框选（比如都是水平的或垂直的）

x_s_s_1 · 发表于 2020-9-15 09:18:10

试试（向量公式来自高飞鸟版主）

(defun c:zxhb (/ MAT:v-v MAT:vxv get_dxf at_line
make_linebylst get_online ss
a lst n lst1 en
jg
)
(defun MAT:v-v (v1 v2)
(mapcar '- v1 v2)
)
(defun MAT:vxv (u v)
(list
(- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
(- (* (car v) (caddr u)) (* (car u) (caddr v)))
(- (* (car u) (cadr v)) (* (car v) (cadr u)))
)
)
(defun get_dxf (en n /) (cdr (assoc n (entget en))))
(defun at_line (en1 pt /)
(equal '(0 0 0)
(MAT:vxv (MAT:v-v (get_dxf en 10) pt)
(MAT:v-v (get_dxf en 11) pt)
)
1e-6
)
)
(defun make_linebylst (lst / lst1 a b x1 x2 y1 y2)
(setq
lst1
(vl-sort
(apply
'append
(mapcar '(lambda (x) (list (get_dxf x 10) (get_dxf x 11)))
lst
)
)
'(lambda (a b)
(setq x1 (car a)
x2 (car b)
y1 (cadr a)
y2 (cadr b)
)
(if (equal x1 x2 1e-6)
(> y1 y2)
(< x1 x2)
)
)
)
)
(entmakex (list '(0 . "line")
(cons 8 (get_dxf (car lst) 8))
(cons 10 (car lst1))
(cons 11 (last lst1))
)
)
)
(defun get_online (en lst / en1 lst1 lst2 out)
(setq lst1 (list en)
lst2 nil
)
(repeat (length lst)
(setq en1 (car lst)
lst (cdr lst)
)
(if (and
(at_line en (get_dxf en1 10))
(at_line en (get_dxf en1 11))
)
(setq lst1 (cons en1 lst1))
(setq lst2 (cons en1 lst2))
)
)
(setq en1 (make_linebylst lst1))
(mapcar 'entdel lst1)
(list en1 lst2)
)
(setq ss (ssget '((0 . "line"))))
(setq a (sslength ss))
(setq lst nil)
(repeat (setq n a)
(setq lst (cons (ssname ss (setq n (1- n))) lst))
)
(while lst
(setq en (car lst)
lst (cdr lst)
)
(setq jg (get_online en lst)
lst (cadr jg)
lst1 (cons (car jg) lst1)
)
)
(princ (strcat "\n共"
(rtos a 2 0)
"条直线合并为"
(rtos (length lst1) 2 0)
"条直线"
)
)
(princ)
)

(defun c:zxhb (/   MAT:v-v   MAT:vxv   get_dxf   at_line 
         make_linebylst     get_online         ss 
         a   lst     n       lst1      en 
         jg 
        ) 
  (defun MAT:v-v (v1 v2) 
    (mapcar '- v1 v2) 
  ) 
  (defun MAT:vxv (u v) 
    (list 
      (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u))) 
      (- (* (car v) (caddr u)) (* (car u) (caddr v))) 
      (- (* (car u) (cadr v)) (* (car v) (cadr u))) 
    ) 
  ) 
  (defun get_dxf (en n /) (cdr (assoc n (entget en)))) 
  (defun at_line (en1 pt /) 
    (equal '(0 0 0) 
     (MAT:vxv (MAT:v-v (get_dxf en 10) pt) 
        (MAT:v-v (get_dxf en 11) pt) 
     ) 
     1e-6 
    ) 
  ) 
  (defun make_linebylst  (lst / lst1 a b x1 x2 y1 y2) 
    (setq 
      lst1 
       (vl-sort 
   (apply 
     'append 
     (mapcar '(lambda (x) (list (get_dxf x 10) (get_dxf x 11))) 
       lst 
     ) 
   ) 
   '(lambda (a b) 
      (setq x1 (car a) 
      x2 (car b) 
      y1 (cadr a) 
      y2 (cadr b) 
      ) 
      (if  (equal x1 x2 1e-6) 
        (> y1 y2) 
        (< x1 x2) 
      ) 
    ) 
       ) 
    ) 
    (entmakex (list '(0 . "line") 
        (cons 8 (get_dxf (car lst) 8)) 
        (cons 10 (car lst1)) 
        (cons 11 (last lst1)) 
        ) 
    ) 
  ) 
  (defun get_online (en lst / en1 lst1 lst2 out) 
    (setq lst1 (list en) 
    lst2 nil 
    ) 
    (repeat (length lst) 
      (setq en1  (car lst) 
      lst  (cdr lst) 
      ) 
      (if (and 
      (at_line en (get_dxf en1 10)) 
      (at_line en (get_dxf en1 11)) 
    ) 
  (setq lst1 (cons en1 lst1)) 
  (setq lst2 (cons en1 lst2)) 
      ) 
    ) 
    (setq en1 (make_linebylst lst1)) 
    (mapcar 'entdel lst1) 
    (list en1 lst2) 
  ) 
  (setq ss (ssget '((0 . "line")))) 
  (setq a (sslength ss)) 
  (setq lst nil) 
  (repeat (setq n a) 
    (setq lst (cons (ssname ss (setq n (1- n))) lst)) 
  ) 
  (while lst 
    (setq en  (car lst) 
    lst (cdr lst) 
    ) 
    (setq jg   (get_online en lst) 
    lst  (cadr jg) 
    lst1 (cons (car jg) lst1) 
    ) 
  ) 
  (princ (strcat "\n共" 
     (rtos a 2 0) 
     "条直线合并为" 
     (rtos (length lst1) 2 0) 
     "条直线" 
   ) 
  ) 
  (princ) 
)

sunny_8848 · 发表于 2020-9-15 09:56:31

自己顶一下

fan_zh · 发表于 2020-9-15 10:32:33

overkill试试

wzg356 · 发表于 2020-9-15 10:56:17

三点是否共线
;;;参数:三个点表 注意不能为相同的点 ;;;
;;;返回值:共线T , 不共线nil ;;;
;;;by wan1314
;;;=========================================================;;;
(defun yy-3ptinline (p1 p2 p3 / v1 v2)
(setq v1 (mapcar '- p1 p2) v2 (mapcar '- p1 p3))
(if (equal (car v1) 0.0 1e-5)
 (equal (car v1) (car v2) 1e-5)
 (equal (abs(/ (cadr v1) (car v1))) (abs(/ (cadr v2) (car v2))) 1e-5)
)
)

函数：xpts-lensort
功能：求点集中最远，最近点表
函数代码：
(defun xpts-lensort (ptlst / pt d maxd mind maxl minl)
 (setq minl (list (car ptlst)(cadr ptlst)) maxd 0 mind (apply 'distance minl))
 (while (setq pt (car ptlst) ptlst (cdr ptlst))
(foreach n ptlst
 (setq d (distance n pt))
 (cond ((< maxd d)(setq maxd d maxl (list n pt)))
 ((> mind d)(setq mind d minl (list n pt)))
 )
)
 )(list maxl minl)
)
语法：
(xpts-lensort ptlst)
参数：
ptlst 点表
返回值：
(最远两点最近两点)

sunny_8848 · 发表于 2020-9-15 12:45:53

fan_zh 发表于 2020-9-15 10:32
overkill试试

谢谢关注。试过，不行

sunny_8848 · 发表于 2020-9-15 12:48:42

wzg356 发表于 2020-9-15 10:56
三点是否共线
;;;参数:三个点表注意不能为相同的点 ;;;
;;;返回值:共线T , ...

谢谢帮忙，可惜自己不会改。在论坛纯粹看得多

start4444 · 发表于 2020-9-15 13:41:07

本帖最后由 start4444 于 2020-9-15 13:46 编辑

对于你的例图是没问题的，如果是存在多条共线的情况有可能出现bug

sunny_8848 · 发表于 2020-9-16 08:01:21

start4444 发表于 2020-9-15 13:41
对于你的例图是没问题的，如果是存在多条共线的情况有可能出现bug

谢谢帮忙。提示 no function definition: VLAX-CURVE-GETCLOSESTPOINTTO，能完善下吗

sunny_8848 · 发表于 2020-9-16 08:02:12

x_s_s_1 发表于 2020-9-15 09:18
试试（向量公式来自高飞鸟版主）

谢谢帮忙，正是我需要的结果

账号		自动登录	找回密码
密码			注册

[讨论] 两共线直线连成一条

最佳答案

评分

本帖子中包含更多资源