求动态拖动矩形的一个角点或一条边的LISP代码

清风明月10 · 发表于 2014-1-5 10:26:30

请问，有没有动态拖动矩形的一个角点或一条边的LISP代码？我不会动态。
我碰到的问题是，我画了一个矩形A，我要微调它的大小，一动，它就变成了非矩形。我希望我拖动它一条边或一个角点时，它永远为矩形，这样就美观。
我希望代码对与坐标轴斜交的矩形也有效。当然如果只是对与坐标轴平行的有效也可以。
这个很有用途的啊。矩形多好看，歪多边形多难看

newer · 发表于 2014-1-5 10:26:31

函数发布里面有很多现成的啊

http://bbs.xdcad.net/forum.php?mod=viewthread&tid=669501

st788796 · 发表于 2014-1-5 10:46:26

你用的CAD什么版本，如果有 GripPoint 用 API 写起来很简单，否则用 API 的 MoveStretchpoint 或者 Polyline_SetPointAt ，最麻烦的就是Grread + vla-put-coordinate 了

清风明月10 · 发表于 2014-1-5 10:49:22

我的是2005。
如果是各版本都适合就更好。
否则只适合2005也可以

清风明月10 · 发表于 2014-1-5 10:57:13

st788796 发表于 2014-1-5 10:46
你用的CAD什么版本，如果有 GripPoint 用 API 写起来很简单，否则用 API 的 MoveStretchpoint 或者 Polylin ...

Grread + vla-put-coordinate，好象这是所有版本都适合的，写好我给你再加10币{:soso_e100:}

st788796 · 发表于 2014-1-5 12:05:16

清风明月10 发表于 2014-1-5 10:57
Grread + vla-put-coordinate，好象这是所有版本都适合的，写好我给你再加10币

先贴部分代码，点在中间位置单边拉伸

(defun c:tt (/ callback callback1 e p pam lst dotn intn pts an an1 lst)
(defun XD::Polyline:SegIndex (e pam / nNums)
(setq nNums (xdrx_polyline_numverts e))
(if (>= (1+ pam) nNums)
(list pam 0)
(list pam (1+ pam))
)
)
(defun callback (dynpt /)
(princ)
)
(defun callback1 (dynpt / d ptl)
(setq d (apply 'xdrx_point_dist2line (cons dynpt pts)))
(setq ptl (mapcar '(lambda (x)
(polar x an1 d)
)
pts
)
)
(mapcar '(lambda (i x)
(xdrx_polyline_setpointat (car e) i x)
)
lst
ptl
)
)
(if (and (setq e (xdrx_entsel "\nPick Pline: " '((0 . "lwpolyline"))))
(xdrx_polyline_compress (car e))
(XD::Polyline:IsRectang (car e))
)
(progn
(xd::begin)
(setq p (cadr e)
pam (apply 'xdrx_curve_getparamatpoint e)
lst (xdrx_math_modf pam)
dotn (car lst)
intn (cadr lst)
pts (xdrx_polyline_getlinesegat (car e) (fix intn))
an (apply 'angle pts)
an1 (- an _pi2)
)
(if (<= 0.34 dotn 0.67)
(progn
(setq lst (XD::Polyline:SegIndex (car e) (fix intn)))
(xdrx_pointmonitor "Callback1" (car e))
(getpoint p)
)
(progn
(setq lst (XD::Polyline:-Index+ (car e intn)))
(xdrx_pointmonitor "callback" (car e))
(getpoint p)
)
)
(xdrx_pointmonitor)
(xd::end)
)
)
(princ)
)

(defun c:tt (/ callback callback1 e p pam lst dotn intn pts an an1 lst) 
  (defun XD::Polyline:SegIndex (e pam / nNums) 
    (setq nNums (xdrx_polyline_numverts e)) 
    (if        (>= (1+ pam) nNums) 
      (list pam 0) 
      (list pam (1+ pam)) 
    ) 
  ) 
  (defun callback (dynpt /) 
   (princ) 
  ) 
  (defun callback1 (dynpt / d ptl) 
    (setq d (apply 'xdrx_point_dist2line (cons dynpt pts))) 
    (setq ptl (mapcar '(lambda (x) 
                         (polar x an1 d) 
                       ) 
                      pts 
              ) 
    ) 
    (mapcar '(lambda (i x) 
               (xdrx_polyline_setpointat (car e) i x) 
             ) 
            lst 
            ptl 
    ) 
  ) 
  (if (and (setq e (xdrx_entsel "\nPick Pline: " '((0 . "lwpolyline")))) 
           (xdrx_polyline_compress (car e)) 
           (XD::Polyline:IsRectang (car e)) 
      ) 
    (progn 
      (xd::begin) 
      (setq p         (cadr e) 
            pam         (apply 'xdrx_curve_getparamatpoint e) 
            lst         (xdrx_math_modf pam) 
            dotn (car lst) 
            intn (cadr lst) 
            pts         (xdrx_polyline_getlinesegat (car e) (fix intn)) 
            an         (apply 'angle pts) 
            an1         (- an _pi2) 
      ) 
      (if (<= 0.34 dotn 0.67) 
        (progn 
          (setq lst (XD::Polyline:SegIndex (car e) (fix intn))) 
          (xdrx_pointmonitor "Callback1" (car e)) 
          (getpoint p) 
        ) 
        (progn 
          (setq lst (XD::Polyline:-Index+ (car e intn))) 
          (xdrx_pointmonitor "callback" (car e)) 
          (getpoint p) 
        ) 
      ) 
      (xdrx_pointmonitor) 
      (xd::end) 
    ) 
  ) 
  (princ) 
)

清风明月10 · 发表于 2014-1-5 13:55:01

st788796 发表于 2014-1-5 12:05
先贴部分代码，点在中间位置单边拉伸

“PICK LINE: ; 错误: *error* 函数中出错参数太多”
我运行的结果显示，有时可以正常运行，有时显示上面的错误代码即不能运行。请你看看原因出在哪里。

清风明月10 · 发表于 2014-1-5 13:57:42

好象加载的第1次可以正常运行，后面就时而出错，时而可以正常运行

清风明月10 · 发表于 2014-1-5 13:59:37

你多去移动几次，就会产生问题。

flyfox1048 · 发表于 2014-1-5 16:26:06

已在MJ回了你的贴子

st788796 · 发表于 2014-1-5 21:32:40

清风明月10 发表于 2014-1-5 13:59
你多去移动几次，就会产生问题。

http://bbs.xdcad.net/thread-672368-1-1.html

风冷雨 · 发表于 2014-1-6 09:36:01

我可以教你做动态块，一劳永逸

清风明月10 · 发表于 2014-1-6 09:38:35

好啊，怎么做啊？

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

[已解决] 求动态拖动矩形的一个角点或一条边的LISP代码

最佳答案

相关帖子

点评

点评

点评