【帮助】改基点、左右翻、上下翻，它的所有功能，都不正常

lizhaojun45

源程序来自：http://bbs.xdcad.net/forum.php?m ... 4%D3%C9%BF%BD%B1%B4
加载到CAD里后，动态移动正常，但是：{改基点[T]/改转角[R]/转90度[A]/镜像[M]/左右翻[S]/上下翻[D]/缩放[L]/对齐[F]/}，这些功能，按了对应的按键，有反应，但全部是不对的结果。下载的是，CAD2016与2021后，是最新的API，店里用的电脑CAD2021+最新的API，又一切正常。我太难了，不知道问题出在哪里。附上，gif动态图
(defun c:xdtb_freecpy ( / an an1 box d1 d2 dynpt kw lastang mat mat1 p1 p2 pt ptbase s1 s2 scl ss ss2 tf yorn)
  (defun _keyword (kw)
    (defun _rcallback (dynpt)
      (if (not lastang)
        (setq lastang (angle p1 dynpt))
      )
      (setq an        (- (setq an1 (angle p1 dynpt)) lastang)
            mat        (xdrx-matrix-setrotation an '(0 0 1) p1)
      )
      (xdrx-entity-transform ss mat)
      (xd::text:adjust ss)
      (setq mat1 (xdrx-matrix-product mat mat1))
      (setq lastang an1)
    )
    (defun _micallback (dynpt)
      (xdrx-entity-delete ss2)
      (setq ss2 (xdrx-entity-copy ss t))
      (setq mat (xdrx-matrix-setmirror (list (trans p1 1 0) dynpt)))
      (xdrx-entity-transform ss2 mat)
      (xd::text:adjust ss2)
      (setq mat1 (xdrx-matrix-product mat mat1))
    )
    (defun _sclcallback        (dynpt)
      (xdrx-entity-delete ss2)
      (setq ss2 (xdrx-entity-copy ss t))
      (setq box (xdrx-points-ucs2wcs (xdrx-entity-box ss2)))
      (setq mat        (xdrx-matrix-setscale
                  (/ (distance dynpt (trans p1 1 0))
                     (distance (car box) (nth 3 box))
                  )
                  (trans p1 1 0)
                )
      )
      (xdrx-entity-transform ss2 mat)
      (xd::text:adjust ss2)
      (setq mat1 (xdrx-matrix-product mat mat1))
    )
    (setq ptbase (xd::drag:getbasepoint))
    (cond
      ((= kw "T")
       (if (setq pt (getpoint "\n新的基点<退出>:"))
         (progn (xd::drag:setbasepoint (trans pt 1 0)))
       )
      )
      ((= kw "A")
       (setq mat (xdrx-matrix-setrotation (/ pi 2.0) '(0 0 1) p1))
       (xdrx-entity-transform ss mat)
      )
      ((= kw "R")
       (setq p1          (xd::drag:getbasepoint)
             mat1 (xdrx-matrix-identity 3)
       )
       (xdrx-pointmonitor "_rcallback")
       (if (not (setq p2 (getpoint p1 "\n旋转轴第二点<退出>:")))
         (progn
           (xdrx-entity-transform ss2 (xdrx-matrix-inverse mat1))
         )
       )
       (xdrx-pointmonitor)
       (xd::drag:setbasepoint (trans p1 1 0))
      )
      ((= kw "M")
       (setq mat1 (xdrx-matrix-identity 3))
       (if (and        (setq p1 (getpoint "\n镜像轴第一点<退出>:"))
                (xdrx-pointmonitor "_micallback")
                (setq p2 (getpoint p1 "\n镜像轴第二点<退出>:"))
           )
         (progn        (setq mat (xdrx-matrix-setmirror
                            (list (trans p1 1 0) (trans p2 1 0))
                          )
                )
                (xdrx-entity-delete ss2)
                (xdrx-entity-transform ss mat)
                (xd::text:adjust ss)
         )
         (progn        (xdrx-entity-transform ss (xdrx-matrix-inverse mat1))
         )
       )
       (xdrx-pointmonitor)
      )
      ((= kw "S")
       (setq mat (xdrx-matrix-setmirror
                   (list ptbase (mapcar '+ ptbase (trans (getvar "ucsydir")1 0 t)))
                 )
       )
       (xdrx-entity-transform ss mat)
       (xd::text:adjust ss)
      )
      ((= kw "D")
       (setq mat (xdrx-matrix-setmirror
                   (list ptbase (mapcar '+ ptbase (trans (getvar "ucsxdir")1 0 t)))
                 )
       )
       (xdrx-entity-transform ss mat)
       (xd::text:adjust ss)
      )
      ((= kw "L")
       (setq mat1 (xdrx-matrix-identity 3))
       (if (and        (setq p1 (getpoint "\n基点<退出>:"))
                (xdrx-pointmonitor "_sclcallback")
                (setq p2 (getpoint p1 "\n镜第二点<输入>:"))
           )
         (progn        (xdrx-entity-delete ss2)
                (xdrx-entity-transform ss mat)
                (xd::text:adjust ss)
         )
         (progn
           (if (setq scl (getreal "\n输入放大比例系数<退出>:"))
             (progn (setq mat (xdrx-matrix-setscale scl (trans p1 1 0)))
                    (xdrx-entity-transform ss mat)
             )
           )
         )
       )
       (xdrx-pointmonitor)
      )
      ((= kw "F")
       (if (and        (setq yorn (xdrx-yesorno "\n是否缩放:" 0))
                (setq s1 (getpoint "\n对齐源轴第一点<退出>:"))
                (setq s2 (getpoint s1 "\n源轴第二点<退出>:"))
                (xdrx-grdraw 1 -1 s1 s2)
                (setq d1 (getpoint "\n对齐目标轴第一点<退出>:"))
                (setq d2 (getpoint d1 "\n对齐目标轴第二点<退出>:"))
           )
         (progn        (xdrx-entity-align
                  ss
                  ptbase
                  (mapcar '+ ptbase (mapcar '- (trans s2 1 0)(trans s1 1 0)))
                  (trans d1 1 0)
                  (trans d2 1 0)
                  (if (= yorn 1)
                    t
                    nil
                  )
                )
         )
       )
      )
    )
    (setq ptbase (xd::drag:getbasepoint))
  )
  (xdrx-begin)
  (xdrx-setvar "picksethome" 1)
  (setq lastang nil)
  (if (and (setq ss (xdrx-ssget "\n选择要处理的对象<退出>:"))
           (setq p1 (getpoint "\n基点<退出>:"))
      )
    (progn (setq tf t)
           (setq ss (xdrx-entity-copy ss t))
           (while (and tf
                       (xdrx-setmark)
                       (xd::doc:setkeyword "R T A M S D L F")
                       (xd::drag:callbacksetkeyword "_keyword")
                       (setq p1
                              (xd::drag:simplemove
                                ss
                                "\r〖拷贝〗插入点或{改基点[T]/改转角[R]/转90度[A]/镜像[M]/左右翻[S]/上下翻[D]/缩放[L]/对齐[F]/}<退出>:"
                                (trans p1 1 0)
                                nil
                              )
                       )
                  )
             (setq ss (xdrx-getss))
           )
           (xdrx-entity-delete ss (xdrx-getss))
    )
  )
  (xdrx-end)
  (princ)
)

yangjian001

做一个热心并受欢迎的人！

xk15c

你说打卡无聊不无聊

lizhaojun45

xk15c 发表于 2021-7-15 18:21
你说打卡无聊不无聊

hh_lj007

打卡打卡！

yuren008

希望这里人气旺一点。

kmliro_2017

谢谢分享!!!!!!!

松树石头哥

感谢楼主分享！！！

lsxwt

感谢楼主分享