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

newer

1. (defun c:tt ( / e eback elast ints inx inx1 msg myerr oclr olderr p1 p-1 p2 p-2 pt pt1 pt2 v1 v2)
   
2.   (defun myerr (msg)
   
3.     (princ (strcat "\n" msg))
   
4.     (redraw)
   
5.     (xdrx_pointmonitor)
   
6.     (xdrx_end)
   
7.     (vl-cmdf ".undo" 1)
   
8.     (setq *error* olderr)
   
9.   )
   
10.   (defun _callback22 (pt)               ; 拖动中的回调处理函数
    
11.     (xdrx_entity_delete elast)
    
12.     (mapcar
    
13.       'set
    
14.       '(p-1 p-2)
    
15.       (XD::Pnts:OrthoProject (list p1 p2) pt (mapcar
    
16.                                                '+
    
17.                                                pt
    
18.                                                v1
    
19.                                              )
    
20.       )
    
21.     )
    
22.     (setq ints (xdrx_curve_getinters (list p-1 p-2) e 3)) ; **裁剪向量和多?
    
23.                                        ; ?
    
24.                                        ; 形的所有交点
    
25.     (if ints
    
26.       (progn
    
27.         (setq ints (mapcar
    
28.                      'cadr
    
29.                      (xdrx_points_sortoncurve (list p1 p2) ints)
    
30.                    )
    
31.               ints (xd::list:dotPair ints) ; 交点集排序后，两两组合
    
32.         )
    
33.         (setq eback (xdrx_entity_copy e)
    
34.               eback (entlast)
    
35.         )
    
36.         (xdrx_setpropertyvalue eback "color" oclr)
    
37.         (setq elast (xdrx_curve_trim eback (list (caar ints) (cadar ints))
    
38.                                      p1 t
    
39.                     )
    
40.         )
    
41.         (entdel eback)
    
42.       )
    
43.     )
    
44.   )
    
45.   (xdrx_begin)
    
46.   (setq olderr *error*)
    
47.   (setq *error* myerr)
    
48.   (if (setq e (xdrx_entsel "\n拾取封闭的多边形<退出>:" '((0 . "*POLYLINE")
    
49.                             (-4 . "&=")
    
50.                             (70 . 1)
    
51.                            )
    
52.               )
    
53.       )
    
54.     (progn
    
55.       (setq inx (XD::Polyline:OnSegAt (car e) (cadr e))
    
56.             e (car e)
    
57.             inx1 (XD::PolyLine:-Index+ e inx)
    
58.             p1 (xdrx_getpropertyvalue e "PointAt" inx)
    
59.             p1 (XD::Pnts:Setz p1 0.0)
    
60.             p2 (xdrx_getpropertyvalue e "PointAt" (last inx1))
    
61.             p2 (XD::Pnts:Setz p2 0.0)
    
62.             pt1 (xdrx_midp p1 p2)
    
63.             v1 (xdrx_vector_normalize (mapcar
    
64.                                         '-
    
65.                                         p2
    
66.                                         p1
    
67.                                       )
    
68.                )
    
69.             v2 (xdrx_vector_perpvector v1)
    
70.       )
    
71.       (setq oclr (xdrx_getpropertyvalue e "color"))
    
72.       (xdrx_setpropertyvalue e "color" 251)
    
73.       (if (setq pt2 (XD::DRAG:GMOVE pt1 "\n边线的位置<退出>:" -1 v2 nil
    
74.                                     "_callback22"
    
75.                     )
    
76.           )                               ; 动态拖动
    
77.         (progn
    
78.           (xdrx_pointmonitor)
    
79.           (_callback22 pt2)
    
80.           (xdrx_entity_delete e)
    
81.         )
    
82.       )
    
83.     )
    
84.   )
    
85.   (xdrx_pointmonitor)
    
86.   (xdrx_end)
    
87.   (setq *error* olderr)
    
88.   (princ)
    
89. )
    
90. 
    

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

liuyj

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

XDSoft

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

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

WhoCanSay

这个功能很强大了。

newer

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

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