对称拉伸

st788796 · 发表于 2014-3-2 13:14:00

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

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

×

lisp版http://bbs.xdcad.net/thread-672769-1-1.html

(defun c:XDTB_MStretch (/ e p p1 p2 p3 p4 sp ep bp)
(if (and (setq e (car (xdrx_entsel "\n选择对称线: " '((0 . "*line")))))
(xdrx_pickset_highlight e nil)
(setq p1 (getpoint "\n第一角点: "))
(setq p2 (getcorner p1 "\n第二角点: "))
(progn
(setq sp (xdrx_curve_getstartpoint e)
ep (xdrx_curve_getendpoint e)
p3 (car (xdrx_points_mirror sp ep p1))
p4 (car (xdrx_points_mirror sp ep p2))
)
(mapcar
'(lambda (x y)
(apply 'xdrx_grdraw (cons -2 (cons 1 x)))
(apply 'xdrx_grdraw (cons -2 (cons 1 y)))
)
(XD::List:SnakePair
(XD::Pnts:Close (xdrx_points_box p1 p2))
)
(XD::List:SnakePair
(XD::Pnts:Close (xdrx_points_box p3 p4))
)
)
t
)
(setq bp (getpoint "\n基点: "))
(setq p (getpoint bp "\n目标点: "))
)
(progn
(XD::BEGIN)
(XD::DOC:DisableOsmode)
(vl-cmdf "._stretch" "C" p1 p2 "" bp p)
(vl-cmdf "._stretch"
"C"
p3
p4
""
(car (xdrx_points_mirror sp ep bp))
(car (xdrx_points_mirror sp ep p))
)
(xdrx_pickset_highlight e t)
(redraw)
(XD::DOC:EnableOsmode)
(XD::END)
)
)
(princ)
)

(defun c:XDTB_MStretch (/ e p p1 p2 p3 p4 sp ep bp) 
  (if (and (setq e (car (xdrx_entsel "\n选择对称线: " '((0 . "*line"))))) 
           (xdrx_pickset_highlight e nil) 
           (setq p1 (getpoint "\n第一角点: ")) 
           (setq p2 (getcorner p1 "\n第二角点: ")) 
           (progn 
             (setq sp (xdrx_curve_getstartpoint e) 
                   ep (xdrx_curve_getendpoint e) 
                   p3 (car (xdrx_points_mirror sp ep p1)) 
                   p4 (car (xdrx_points_mirror sp ep p2)) 
             ) 
             (mapcar 
               '(lambda        (x y) 
                  (apply 'xdrx_grdraw (cons -2 (cons 1 x))) 
                  (apply 'xdrx_grdraw (cons -2 (cons 1 y))) 
                ) 
               (XD::List:SnakePair 
                 (XD::Pnts:Close (xdrx_points_box p1 p2)) 
               ) 
               (XD::List:SnakePair 
                 (XD::Pnts:Close (xdrx_points_box p3 p4)) 
               ) 
             ) 
             t 
           ) 
           (setq bp (getpoint "\n基  点: ")) 
           (setq p (getpoint bp "\n目标点: ")) 
      ) 
    (progn 
      (XD::BEGIN) 
      (XD::DOC:DisableOsmode) 
      (vl-cmdf "._stretch" "C" p1 p2 "" bp p) 
      (vl-cmdf "._stretch" 
               "C" 
               p3 
               p4 
               "" 
               (car (xdrx_points_mirror sp ep bp)) 
               (car (xdrx_points_mirror sp ep p)) 
      ) 
      (xdrx_pickset_highlight e t) 
      (redraw) 
      (XD::DOC:EnableOsmode) 
      (XD::END) 
    ) 
  ) 
  (princ) 
)

qqqincccken · 发表于 2014-3-2 13:22:04

谢谢楼主提供,试用一下!!

ysq101 · 发表于 2014-3-2 13:47:24

哈哈。。。还是改为点选对称轴了呀
LISP通用函数我这边加载不了。。。

我还是用你的LISP版自己改改用好了。。

谢谢分享

ysq101 · 发表于 2014-3-2 13:51:47

虽然我测试不了。。。但看了你一下源码。。。
好像拉伸距离使用了点到点的距离？？
那不好控制啊！可否改用getdist呢？？？正数拉大，，，，负数拉小

st788796 · 发表于 2014-3-2 17:33:58

本帖最后由 st788796 于 2014-3-2 18:10 编辑

ysq101 发表于 2014-3-2 13:51
虽然我测试不了。。。但看了你一下源码。。。
好像拉伸距离使用了点到点的距离？？
那不好控制啊！ ...

Getdist 是非负数，有正负的需用Getreal，用Getdist要能获取拾取点和基点及对称线的相对关系
可以去掉基点选择

ysq101 · 发表于 2014-3-2 19:13:26

st788796 发表于 2014-3-2 17:33
Getdist 是非负数，有正负的需用Getreal，用Getdist要能获取拾取点和基点及对称线的相对关系
可以去掉 ...

我错了。。。刚试了一下你LISP版的程序
直接移鼠标确定拉大拉小，，，更方便
高手

st788796 · 发表于 2014-3-2 20:15:58

ysq101 发表于 2014-3-2 19:13
我错了。。。刚试了一下你LISP版的程序
直接移鼠标确定拉大拉小，，，更方便
高手

既是对称，应该是和轴垂直的拉伸，因为没有这个应用经验，只是猜想，如果是确可再简化

ysq101 · 发表于 2014-3-2 22:25:02

st788796 发表于 2014-3-2 20:15
既是对称，应该是和轴垂直的拉伸，因为没有这个应用经验，只是猜想，如果是确可再简化

确实是轴垂直的拉伸
既然是拉伸我从来就没有拉过斜方向的
因为没那必要

st788796 · 发表于 2014-3-2 22:35:43

ysq101 发表于 2014-3-2 22:25
确实是轴垂直的拉伸
既然是拉伸我从来就没有拉过斜方向的
因为没那必要

既然这样，直接改用getreal

ysq101 · 发表于 2014-3-2 23:38:43

st788796 发表于 2014-3-2 22:35
既然这样，直接改用getreal

还是看大家的意见吧...这只是我个人的习惯

tangsz2006 · 发表于 2014-10-9 22:23:58

可以用得上

xinyeyu · 发表于 2016-2-24 21:28:04

可以设置水平拉伸吗？？

墙角哥 · 发表于 2016-5-27 10:54:53

谢谢楼主分享！赞一个！

a88611462 · 发表于 2016-11-7 15:03:39

正需要，支持楼主大人了！

yoyoho · 发表于 2016-11-8 11:21:28

谢谢楼主分享！赞一个！

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

[工具] 对称拉伸

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

点评

点评

点评