论坛 › XDRX_API应用 › 多边形单边退缩（XD::Drag:Gmove应用）

newer 发表于 2016-5-31 11:37:41

多边形单边退缩（XD::Drag:Gmove应用）

(defun c:tt ( / e eback elast ints inx inx1 msg myerr oclr olderr p1 p-1 p2 p-2 pt pt1 pt2 v1 v2)
(defun myerr (msg)
    (princ (strcat "\n" msg))
    (redraw)
    (xdrx_pointmonitor)
    (xdrx_end)
    (vl-cmdf ".undo" 1)
    (setq *error* olderr)
)
(defun _callback22 (pt)               ; 拖动中的回调处理函数
    (xdrx_entity_delete elast)
    (mapcar
      'set
      '(p-1 p-2)
      (XD::Pnts:OrthoProject (list p1 p2) pt (mapcar
                                             '+
                                             pt
                                             v1
                                             )
      )
    )
    (setq ints (xdrx_curve_getinters (list p-1 p-2) e 3)) ; **裁剪向量和多?
                                       ; ?
                                       ; 形的所有交点
    (if ints
      (progn
      (setq ints (mapcar
                     'cadr
                     (xdrx_points_sortoncurve (list p1 p2) ints)
                   )
            ints (xd::list:dotPair ints) ; 交点集排序后，两两组合
      )
      (setq eback (xdrx_entity_copy e)
            eback (entlast)
      )
      (xdrx_setpropertyvalue eback "color" oclr)
      (setq elast (xdrx_curve_trim eback (list (caar ints) (cadar ints))
                                     p1 t
                  )
      )
      (entdel eback)
      )
    )
)
(xdrx_begin)
(setq olderr *error*)
(setq *error* myerr)
(if (setq e (xdrx_entsel "\n拾取封闭的多边形<退出>:" '((0 . "*POLYLINE")
                            (-4 . "&=")
                            (70 . 1)
                           )
            )
      )
    (progn
      (setq inx (XD::Polyline:OnSegAt (car e) (cadr e))
            e (car e)
            inx1 (XD::PolyLine:-Index+ e inx)
            p1 (xdrx_getpropertyvalue e "PointAt" inx)
            p1 (XD::Pnts:Setz p1 0.0)
            p2 (xdrx_getpropertyvalue e "PointAt" (last inx1))
            p2 (XD::Pnts:Setz p2 0.0)
            pt1 (xdrx_midp p1 p2)
            v1 (xdrx_vector_normalize (mapcar
                                        '-
                                        p2
                                        p1
                                    )
               )
            v2 (xdrx_vector_perpvector v1)
      )
      (setq oclr (xdrx_getpropertyvalue e "color"))
      (xdrx_setpropertyvalue e "color" 251)
      (if (setq pt2 (XD::DRAG:GMOVE pt1 "\n边线的位置<退出>:" -1 v2 nil
                                    "_callback22"
                  )
          )                               ; 动态拖动
      (progn
          (xdrx_pointmonitor)
          (_callback22 pt2)
          (xdrx_entity_delete e)
      )
      )
    )
)
(xdrx_pointmonitor)
(xdrx_end)
(setq *error* olderr)
(princ)
)

liuyj 发表于 2016-6-2 15:08:02

不能运行，提示“参数太多”

XDSoft 发表于 2016-6-2 15:29:21

liuyj 发表于 2016-6-2 15:08
不能运行，提示“参数太多”

重新下载 XD::DRAG:GMOVE 这个函数。 更新了。

WhoCanSay 发表于 2016-6-3 15:21:19

这个功能很强大了。

newer 发表于 2016-6-3 15:37:47

WhoCanSay 发表于 2016-6-3 15:21
这个功能很强大了。

欢迎加入，一起研究使用XDRX API开发程序。

gdfyhao 发表于 2024-12-30 12:03:31

在2014和2018版本下运行代码，都出不来动图中的效果，多边形均显示为灰色线，并且点击确定插入点后，多边形就被删除了

gdfyhao 发表于 2024-12-30 17:23:23

gdfyhao 发表于 2024-12-30 12:03
在2014和2018版本下运行代码，都出不来动图中的效果，多边形均显示为灰色线，并且点击确定插入点后，多边形 ...

花费了不少时间，已经找到原因了，回调函数中最后一句entdel eback删除掉就可以了

查看完整版本: 多边形单边退缩（XD::Drag:Gmove应用）