XD::Drag:Rectang不能拖动

liuyj · 发表于 2017-10-14 00:57:35

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

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

×

1010的API，R19x64的，XD::Drag:Rectang好像不能拖动了，请大家测试一下是不是

sicky111 · 发表于 2017-10-15 00:02:41

有空试一下。

newer · 发表于 2017-10-16 09:56:30

把下面代码拷贝回去，试试

(defun XD::Drag:Rectang (info pts / an dynpt en flag index
ins ll newpoint per pl pnt v v0
)
(defun RecCallback1 (dynpt /)
(setq ins (car (xd::pnts:orthoproject (list dynpt) p1 p2)))
(setq vec (mapcar
'-
dynpt
ins
)
)
(if (not lastPnts)
(setq lastPnts (cons dynpt lastPnts))
(setq lastPnts (list dynpt (car lastPnts)))
)
(xdrx_polyline_setpointat en 2 (setq ret (mapcar
'+
p2
vec
))
)
(xdrx_polyline_setpointat en 3 (mapcar
'+
p1
vec
)
)
(setq ret (trans ret 0 1))
ret
)
(defun RecCallback2 (dynpt /)
(setq p3 dynpt
p2 (mapcar '+ p1 xdir)
p2 (car (xd::pnts:orthoproject (list p3) p1 p2))
p4 (car (xd::pnts:orthoproject (list p3) p1 (mapcar '+ p1 ydir)))
)
(if (not lastPnts)
(setq lastPnts (cons dynpt lastPnts))
(setq lastPnts (list dynpt (car lastPnts)))
)
(xdrx_polyline_setpointat en 1 p2)
(xdrx_polyline_setpointat en 2 dynpt)
(xdrx_polyline_setpointat en 3 p4)
dynpt
)
(defun myerr(msg)
(princ (strcat "\n" msg))
(setq *error* myerr)
(xdrx_end)
(XD::Doc:Command (list ".undo" 1))
)
(setq olderr *error*)
(setq *error* myerr)
(xdrx_begin)
(setq p1 (car pts)
p2 (cadr pts)
flag 0
) ; the center of five-star
(setq p1 (trans p1 1 0))
(if p2
(setq p2 (trans p2 1 0))
)
(setq xdir(getvar "ucsxdir")
ydir (getvar "ucsydir")
)
(setvar "lastPoint" (trans p1 0 1))
(if (not p2)
(progn
(setq ll (list p1 p1 p1 p1))
)
(progn
(setq flag 1)
(setq ll (list p1 p2 p2 p1))
(setq v0 (mapcar
'-
p2
p1
)
)
(setq an (angle p1 p2)) ; |start to drag it
)
)
(initget 0)
(setq en (xdrx_polyline_make (car ll)(cadr ll)))
(xdrx_polyline_addvertexat en 2 (cadr ll))
(xdrx_polyline_addvertexat en 3 (car ll))
(xdrx_setpropertyvalue en "closed" t)
(xdrx_pointmonitor (if (= flag 1)
"RecCallback1"
"RecCallback2"
)
)
(setq p3 (getpoint info))
(xdrx_pointmonitor)
(cond
((= (type p3) 'STR)
(entdel e)
)
((= (type ret) 'LIST)
(if (not (equal (car lastpnts) (last lastpnts) 30))
(progn
(if (cadr pts)
(progn
(setq dis (distance (car lastpnts) p1)
vec (xdrx_vector_product (xdrx_vector_normalize vec) dis)
p3 (mapcar '+ p2 vec)
p4 (mapcar '+ p1 vec)
)
(xdrx_polyline_setpointat en 2 p3)
(xdrx_polyline_setpointat en 3 p4)
(setq p3 (trans p3 0 1))
)
)
)
)
)
)
(setq *error* olderr)
(xdrx_end)
p3
)

(defun XD::Drag:Rectang (info pts / an dynpt en flag index 
                              ins ll newpoint  per pl pnt v v0 
                              
                        ) 
  (defun RecCallback1 (dynpt /) 
    (setq ins (car (xd::pnts:orthoproject (list dynpt) p1 p2))) 
    (setq vec (mapcar 
                '- 
                dynpt 
                ins 
              ) 
    ) 
    (if (not lastPnts) 
      (setq lastPnts (cons dynpt lastPnts)) 
      (setq lastPnts (list dynpt (car lastPnts))) 
    ) 
    (xdrx_polyline_setpointat en 2 (setq ret (mapcar 
                                     '+ 
                                     p2 
                                     vec 
                                   )) 
    ) 
    (xdrx_polyline_setpointat en 3 (mapcar 
                                     '+ 
                                     p1 
                                     vec 
                                   ) 
    ) 
    (setq ret (trans ret 0 1)) 
    ret 
  ) 
  (defun RecCallback2 (dynpt /) 
    (setq p3 dynpt 
          p2 (mapcar '+ p1 xdir) 
          p2 (car (xd::pnts:orthoproject (list p3) p1 p2)) 
          p4 (car (xd::pnts:orthoproject (list p3) p1 (mapcar '+ p1 ydir))) 
    ) 
    (if (not lastPnts) 
      (setq lastPnts (cons dynpt lastPnts)) 
      (setq lastPnts (list dynpt (car lastPnts))) 
    ) 
    (xdrx_polyline_setpointat en 1 p2) 
    (xdrx_polyline_setpointat en 2 dynpt) 
    (xdrx_polyline_setpointat en 3 p4) 
    dynpt 
  )        
  (defun myerr(msg) 
     (princ (strcat "\n" msg)) 
     (setq *error* myerr) 
     (xdrx_end) 
     (XD::Doc:Command (list ".undo" 1)) 
  ) 
  (setq olderr *error*) 
  (setq *error* myerr) 
  (xdrx_begin)                                
  (setq p1 (car pts) 
        p2 (cadr pts) 
        flag 0 
  )                                       ; the center of five-star 
  (setq p1 (trans p1 1 0)) 
  (if p2 
    (setq p2 (trans p2 1 0)) 
  ) 
  (setq xdir(getvar "ucsxdir") 
        ydir (getvar "ucsydir") 
  ) 
  (setvar "lastPoint" (trans p1 0 1)) 
  (if (not p2) 
    (progn 
      (setq ll (list p1 p1 p1 p1)) 
    ) 
    (progn 
      (setq flag 1) 
      (setq ll (list p1 p2 p2 p1)) 
      (setq v0 (mapcar 
                 '- 
                 p2 
                 p1 
               ) 
      ) 
      (setq an (angle p1 p2)) ; |start to drag it 
    ) 
  ) 
  (initget 0) 
  (setq en (xdrx_polyline_make (car ll)(cadr ll))) 
  (xdrx_polyline_addvertexat en 2 (cadr ll)) 
  (xdrx_polyline_addvertexat en 3 (car ll)) 
  (xdrx_setpropertyvalue en "closed" t) 
  (xdrx_pointmonitor (if (= flag 1) 
                             "RecCallback1" 
                             "RecCallback2" 
                           ) 
  ) 
  (setq p3 (getpoint info)) 
  (xdrx_pointmonitor) 
  (cond 
    ((= (type p3) 'STR) 
      (entdel e) 
    ) 
    ((= (type ret) 'LIST) 
      (if (not (equal (car lastpnts) (last lastpnts) 30)) 
        (progn 
          (if (cadr pts) 
            (progn 
              (setq dis (distance (car lastpnts) p1) 
                    vec (xdrx_vector_product (xdrx_vector_normalize vec) dis) 
                    p3 (mapcar '+ p2 vec) 
                    p4 (mapcar '+ p1 vec) 
              ) 
              (xdrx_polyline_setpointat en 2 p3) 
              (xdrx_polyline_setpointat en 3 p4) 
              (setq p3 (trans p3 0 1)) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (setq *error* olderr) 
  (xdrx_end) 
  p3 
)

XDSoft · 发表于 2017-10-16 11:11:29

请更新2017.10.18 通用LISP函数库。

liuyj · 发表于 2017-10-16 16:43:42

N版这个对http://bbs.xdcad.net/forum.php?m ... 3A%3ADrag%3ARectang中的例子，不能实现单点模式。对于自由矩形这个插件也不能用。http://bbs.xdcad.net/forum.php?m ... 4%D3%C9%BE%D8%D0%CE

liuyj · 发表于 2017-10-16 16:53:17

自由矩形可以修改一下，能用
(defun c:XDRX_FreeRec (/ e1 e2 p1 p2 p3 pts ss)
 (while (and (setq p1 (getpoint "\n矩形第一点<退出>:"))
 (or (and (setq ss (xdrx_pickset_getAtPoint
 p1
 (XD::Doc:GetPickboxHeight)
 9
 '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))
)
 )
 (= 1 (sslength ss))
 (setq e1 (xdrx_getentdata 9))
 )
 (progn (setq e1 nil) t)
 )
 (setq p3 (getpoint "\n矩形第二点<退出>:"))
 (setq p2 (XD::Drag:Rectang "\n矩形第三点<退出>:" (list p1 p3)))
 )
(if (and e1
 (setq pts (xdrx_getsamplept e1))
 (not (XD::Pnt:IsOn p2 pts))
)
 (progn (if (XD::Pnt:IsOut p2 pts)
 (xdrx_curve_union e1 (setq e2 (entlast)) 0)
 (xdrx_curve_subtract e1 (setq e2 (entlast)) 0)
 )
 )
)
(or (xdrx_polyline_compress (entlast) t)
(purge-pline (entlast))
)
(setq e1 nil)
(initget 0)
 )
 (princ)
)

liuyj · 发表于 2017-10-16 16:54:46

N版再改改，如果pts是一个点，就按对角线拖动矩形。

liuyj · 发表于 2018-5-7 17:30:12

加载0508的API后，这个函数又出问题了。这次只能向两点的延长线方向移动，画出来的是一条线段

XDSoft · 发表于 2018-5-7 20:45:27

liuyj 发表于 2018-5-7 17:30
加载0508的API后，这个函数又出问题了。这次只能向两点的延长线方向移动，画出来的是一条线段

更新了 API和工具箱，重新下载下试试。

liuyj · 发表于 2018-5-7 22:28:10

问题解决了

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

[BUG报告] XD::Drag:Rectang不能拖动

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

点评