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

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

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

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

×

(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)
)

(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应用）

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

点评

点评

点评

浏览过的版块