两线平行时，画梯形腰线

/db_自贡黄明儒_ · 发表于 2013-11-18 11:25:35

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 /db_自贡黄明儒_ 于 2013-11-18 13:48 编辑

;;两线平行时，画梯形腰线
(defun HH:waist (en1 en2 / E1EN E1ST E2EN E2ST LST P0 P1E P1S P2E P2S P3 X Y)
(setq e1st (vlax-curve-getStartPoint en1))
(setq e1en (vlax-curve-getendPoint en1))
(setq e2st (vlax-curve-getStartPoint en2))
(setq e2en (vlax-curve-getendPoint en2))
(setq lst (list (list (distance e1st e2st) e1st e2st)
(list (distance e1st e2en) e1st e2en)
(list (distance e1en e2st) e1en e2st)
(list (distance e1en e2en) e1en e2en)
)
)
;;http://www.xdcad.net/forum/thread-670556-1-4.html HH:ssPts:Sort定义
(setq lst (car(mapcar 'cdr (HH:ssPts:Sort lst "X" 0.0001))));最远两点
(if (equal (car lst) e1st 0.0001)
(setq p1s e1st p1e e1en)
(setq p1s e1en p1e e1st)
)
(if (equal (cadr lst) e2st 0.0001)
(setq p2s e2en p2e e2en)
(setq p2s e2st p2e e2en)
)
(setq P0 (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) p1s p2s))
(setq P3 (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) p1e p2e))
(entmake (list (cons 0 "LINE") (cons 10 P0) (cons 11 P3)))
)
(defun C:W2 (/ EN1 EN2)
(setq en1 (car (entsel)))
(setq en2 (car (entsel)))
(HH:waist en1 en2)
(princ)
)

;;两线平行时，画梯形腰线 
(defun HH:waist (en1 en2 / E1EN E1ST E2EN E2ST LST P0 P1E P1S P2E P2S P3 X Y) 
  (setq e1st (vlax-curve-getStartPoint en1)) 
  (setq e1en (vlax-curve-getendPoint en1)) 
  (setq e2st (vlax-curve-getStartPoint en2)) 
  (setq e2en (vlax-curve-getendPoint en2)) 
  (setq lst (list (list (distance e1st e2st) e1st e2st) 
    (list (distance e1st e2en) e1st e2en) 
    (list (distance e1en e2st) e1en e2st) 
    (list (distance e1en e2en) e1en e2en) 
     ) 
  ) 
  ;;<a href=\"http://www.xdcad.net/forum/thread-670556-1-4.html\" target=\"_blank\">http://www.xdcad.net/forum/thread-670556-1-4.html</a> HH:ssPts:Sort定义 
  (setq lst (car(mapcar 'cdr (HH:ssPts:Sort lst "X" 0.0001))));最远两点 
  (if (equal (car lst) e1st 0.0001) 
    (setq p1s e1st p1e e1en) 
    (setq p1s e1en p1e e1st) 
  ) 
  (if (equal (cadr lst) e2st 0.0001) 
    (setq p2s e2en p2e e2en) 
    (setq p2s e2st p2e e2en)    
  )         
   
  (setq P0 (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) p1s p2s)) 
  (setq P3 (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) p1e p2e)) 
  (entmake (list (cons 0 "LINE") (cons 10 P0) (cons 11 P3))) 
) 
(defun C:W2 (/ EN1 EN2) 
  (setq en1 (car (entsel))) 
  (setq en2 (car (entsel))) 
  (HH:waist en1 en2) 
  (princ) 
)

st788796 · 发表于 2013-11-18 12:54:39

不如上个图看的明白

Lispboy · 发表于 2013-11-18 13:17:17

是啊，楼主配个图更好了。

st788796 · 发表于 2013-11-18 15:19:17

既然是水平线，把四个点放一起先 Y 后 X 排序，取 1 4 和 2 3 的中点不简单？

/db_自贡黄明儒_ · 发表于 2013-11-18 16:14:02

st788796 发表于 2013-11-18 15:19
既然是水平线，把四个点放一起先 Y 后 X 排序，取 1 4 和 2 3 的中点不简单？

不是水平线的问题
通常我们画的零件是对称的。有时候，这两根对称的线已经画好，要找它的对称中心线

st788796 · 发表于 2013-11-18 17:58:18

/db_自贡黄明儒_ 发表于 2013-11-18 16:14
不是水平线的问题
通常我们画的零件是对称的。有时候，这两根对称的线已经画好，要找它的对称中心线

另外一个思路

(defun c:tt (/ ss pts)
(if (and (setq ss (ssget '((0 . "line"))))
(= (sslength ss) 2)
)
(progn
(setq pts (apply 'append
(mapcar '(lambda (x) (xdrx_curve_getpoint x))
(setq el (xdrx_pickset->ents ss))
)
)
pts (XD::Pnts:Close (xdrx_points_gethull pts))
pts (mapcar '(lambda (x y) (xdrx_line_midp x y))
pts
(cdr pts)
)
pts (vl-remove-if
'(lambda (x)
(or (equal x
(xdrx_curve_getclosestpoint (car el) x)
1e-3
)
(equal x
(xdrx_curve_getclosestpoint (cadr el) x)
1e-3
)
)
)
pts
)
)
(apply 'xdrx_line_make pts)
)
)
(princ)
)

(defun c:tt (/ ss pts) 
  (if (and (setq ss (ssget '((0 . "line")))) 
           (= (sslength ss) 2) 
      ) 
    (progn 
      (setq pts        (apply 'append 
                       (mapcar '(lambda (x) (xdrx_curve_getpoint x)) 
                               (setq el (xdrx_pickset->ents ss)) 
                       ) 
                ) 
            pts        (XD::Pnts:Close (xdrx_points_gethull pts)) 
            pts        (mapcar        '(lambda (x y) (xdrx_line_midp x y)) 
                        pts 
                        (cdr pts) 
                ) 
            pts        (vl-remove-if 
                  '(lambda (x) 
                     (or (equal        x 
                                (xdrx_curve_getclosestpoint (car el) x) 
                                1e-3 
                         ) 
                         (equal        x 
                                (xdrx_curve_getclosestpoint (cadr el) x) 
                                1e-3 
                         ) 
                     ) 
                   ) 
                  pts 
                ) 
      ) 
      (apply 'xdrx_line_make pts) 
    ) 
  ) 
  (princ) 
)

xyp1964 · 发表于 2013-11-18 22:52:41

;; 两平行线的腰线
(defun c:tt ()
(defun mid (p1 p2)
(mapcar '(lambda (x) (/ x 2.)) (mapcar '+ p1 p2))
)
(defun bbb (p1 p2)
(entmake (list '(0 . "line") (cons 10 p1) (cons 11 p2)))
)
(setq s1 (car (entsel "\n选择直线1: "))
s2 (car (entsel "\n选择直线2: "))
p1 (vlax-curve-getStartPoint s1)
p2 (vlax-curve-getEndPoint s1)
p3 (vlax-curve-getStartPoint s2)
p4 (vlax-curve-getEndPoint s2)
)
(if (not (inters p1 p2 p3 p4))
(if (inters p1 p4 p2 p3)
(bbb (mid p1 p3) (mid p2 p4))
(bbb (mid p1 p4) (mid p2 p3))
)
)
(princ)
)

st788796 · 发表于 2013-11-18 23:42:08

受院长启发,修改如下

(defun c:tt (/ ss p1 p2 p3 p4)
(if (and (setq ss (ssget '((0 . "line"))))
(= (sslength ss) 2)
)
(progn
(mapcar 'set
'(p1 p2 p3 p4)
(apply 'append
(mapcar '(lambda (x)
(list (xdrx_curve_getstartpoint x)
(xdrx_curve_getendpoint x)
)
)
(xdrx_pickset->ents ss)
)
)
)
(if (inters p1 p3 p2 p4)
(xdrx_line_make
(xdrx_line_midp p1 p4)
(xdrx_line_midp p2 p3)
)
(xdrx_line_make
(xdrx_line_midp p1 p3)
(xdrx_line_midp p2 p4)
)
)
)
)
(princ)
)

金鹅起飞 · 发表于 2013-11-19 08:14:22

厉害，佩服各位，向您们学习！

/db_自贡黄明儒_ · 发表于 2013-11-19 08:23:56

st788796 发表于 2013-11-18 23:42
受院长启发,修改如下

你是假定了那两根蓝色线存在的吗？会不会出现那根中线很短的情况？

st788796 · 发表于 2013-11-19 09:31:38

本帖最后由 st788796 于 2013-11-19 09:32 编辑

/db_自贡黄明儒_ 发表于 2013-11-19 08:23
你是假定了那两根蓝色线存在的吗？会不会出现那根中线很短的情况？

不存在也能画，原理就是假定顺序存在inters就交换下，这样两线端点就对应了，不需要排序，这个可以和另外那个找对称轴合并
平行能画，不平行也能画

/db_自贡黄明儒_ · 发表于 2013-11-19 21:37:05

st788796 发表于 2013-11-19 09:31
不存在也能画，原理就是假定顺序存在inters就交换下，这样两线端点就对应了，不需要排序，这个可以和另 ...

本程序就是找对称轴了

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

[研讨] 两线平行时，画梯形腰线

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

点评

评分

点评

点评

点评