XDGE几何库应用(28)--根据四边长及对角线数据绘制四边形

st788796 · 发表于 2014-10-31 23:16:35

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

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

×

本帖最后由 st788796 于 2014-11-1 07:53 编辑

相关链接
已知四边形的四条边长和一条对角线自动画四边形
http://bbs.xdcad.net/thread-676647-1-1.html

(defun c:tt (/ fl lst p c1 c2 normal cc3d l1 l2 l3 l4 l5 p nlst tf bp)
(defun _makerotate (pts /)
(mapcar '(lambda (x y / dm)
(setq dm (xdrx_dimension_makerotate
x
y
(xdrx_line_midp x y)
(angle x y)
);_字高随当前样式
)
(xdrx_setpropertyvalue
dm "DIMBLK1" "_None" "DIMBLK2" "_None"
"DIMSAH" T "DIMSD1" T "DIMSD2"
T "DIMSE1" T "DIMSE2" T
)
)
pts
(cdr pts)
)
)
(if (and (setq fl (getfiled "Select txt" "" "txt" 8))
(setq lst (xd::list:fromfile fl))
(setq p (getpoint "\nbase point: "))
)
(progn
(setq lst (mapcar 'distof lst))
(while lst
(mapcar 'set '(l1 l2 l3 l4 l5) lst)
(setq nlst (cons (list l1 l2 l3 l4 l5) nlst)
lst (cdr (cddddr lst))
)
);_处理边长分组
(setq c1 (xdge::constructor "kCircArc3d");_默认圆1
c2 (xdge::constructor "kCircArc3d");_默认圆2
normal '(0.0 0.0 1.0)
cc3d (xdge::constructor "kCurveCurveInt3d");_建立相交体
)
(mapcar
'(lambda (x / p1 p2 p3 box l1 l2 l3 l4 l5 pl vx ln dm dm1)
(mapcar 'set '(l1 l2 l3 l4 l5) x)
(setq p3 (polar p 0. l4))
(xdge::setpropertyvalue c1 "set" p normal l1);_重新设置圆心半径
(xdge::setpropertyvalue c2 "set" p3 normal l5);_重新设置圆心半径
(xdge::setpropertyvalue cc3d "set" c1 c2 normal);_设置相交体为 c1 c2
(setq p1 (car (vl-remove-if-not
'(lambda (a)
(minusp (xdrx_point_dist2line a p p3));_仅保留上部的交点
)
(xdge::getpropertyvalue cc3d "intPoints");_两圆交点
)
)
)
(xdge::setpropertyvalue c1 "set" p1 normal l2);_重新设置圆1
(xdge::setpropertyvalue c2 "set" p3 normal l3);_重新设置圆2
(setq p2 (car (vl-remove-if-not
'(lambda (a)
(minusp (xdrx_point_dist2line a p1 p3));_仅保留斜线左侧点
)
(xdge::getpropertyvalue cc3d "intPoints");_重新取得相交体交点
)
)
pl (xdrx_polyline_make t p p1 p2 p3)
box (xdrx_entity_box pl)
ln (xdrx_line_make p1 p3)
dm (_makerotate (list p p1 p2 p3 p))
dm1 (car (_makerotate (list p1 p3)))
)
(if bp
(progn
(xdrx_entity_move
(append (list dm1 pl ln) dm)
(car box)
bp
);_移动
(setq bp (mapcar '+
bp
(mapcar '- (cadr box) (car box))
'(300. 0. 0.)
)
)
)
(setq bp (polar (cadr box) 0. 300))
)
(setq tf t)
)
(reverse nlst)
)
(xdge::free);_释放 Ge
)
)
(princ)
)

(defun c:tt (/ fl lst p c1 c2 normal cc3d l1 l2 l3 l4 l5 p nlst tf bp) 
  (defun _makerotate (pts /) 
    (mapcar '(lambda (x y / dm) 
               (setq dm        (xdrx_dimension_makerotate 
                          x 
                          y 
                          (xdrx_line_midp x y) 
                          (angle x y) 
                        );_字高随当前样式 
               ) 
               (xdrx_setpropertyvalue 
                 dm           "DIMBLK1" "_None"   "DIMBLK2" "_None" 
                 "DIMSAH"  T             "DIMSD1"  T         "DIMSD2" 
                 T           "DIMSE1"  T               "DIMSE2"         T 
                ) 
             ) 
            pts 
            (cdr pts) 
    ) 
  ) 
  (if (and (setq fl (getfiled "Select txt" "" "txt" 8)) 
           (setq lst (xd::list:fromfile fl)) 
           (setq p (getpoint "\nbase point: ")) 
      ) 
    (progn 
      (setq lst (mapcar 'distof lst)) 
      (while lst 
        (mapcar 'set '(l1 l2 l3 l4 l5) lst) 
        (setq nlst (cons (list l1 l2 l3 l4 l5) nlst) 
              lst  (cdr (cddddr lst)) 
        ) 
      );_处理边长分组 
      (setq c1           (xdge::constructor "kCircArc3d");_默认圆1 
            c2           (xdge::constructor "kCircArc3d");_默认圆2 
            normal '(0.0 0.0 1.0) 
            cc3d   (xdge::constructor "kCurveCurveInt3d");_建立相交体 
      ) 
      (mapcar 
        '(lambda (x / p1 p2 p3 box l1 l2 l3 l4 l5 pl vx ln dm dm1) 
           (mapcar 'set '(l1 l2 l3 l4 l5) x) 
           (setq p3 (polar p 0. l4)) 
           (xdge::setpropertyvalue c1 "set" p normal l1);_重新设置圆心半径 
           (xdge::setpropertyvalue c2 "set" p3 normal l5);_重新设置圆心半径 
           (xdge::setpropertyvalue cc3d "set" c1 c2 normal);_设置相交体为 c1 c2 
           (setq p1 (car (vl-remove-if-not 
                           '(lambda (a) 
                              (minusp (xdrx_point_dist2line a p p3));_仅保留上部的交点 
                            ) 
                           (xdge::getpropertyvalue cc3d "intPoints");_两圆交点 
                         ) 
                    ) 
           ) 
           (xdge::setpropertyvalue c1 "set" p1 normal l2);_重新设置 圆1 
           (xdge::setpropertyvalue c2 "set" p3 normal l3);_重新设置 圆2 
           (setq p2  (car (vl-remove-if-not 
                            '(lambda (a) 
                               (minusp (xdrx_point_dist2line a p1 p3));_仅保留斜线左侧点 
                             ) 
                            (xdge::getpropertyvalue cc3d "intPoints");_重新取得相交体交点 
                          ) 
                     ) 
                 pl  (xdrx_polyline_make t p p1 p2 p3) 
                 box (xdrx_entity_box pl) 
                 ln  (xdrx_line_make p1 p3) 
                 dm  (_makerotate (list p p1 p2 p3 p)) 
                 dm1 (car (_makerotate (list p1 p3))) 
           ) 
           (if bp 
             (progn 
               (xdrx_entity_move 
                 (append (list dm1 pl ln) dm) 
                 (car box) 
                 bp 
               );_移动 
               (setq bp        (mapcar        '+ 
                                bp 
                                (mapcar '- (cadr box) (car box)) 
                                '(300. 0. 0.) 
                        ) 
               ) 
             ) 
             (setq bp (polar (cadr box) 0. 300)) 
           ) 
           (setq tf t) 
         ) 
        (reverse nlst) 
      ) 
      (xdge::free);_释放 Ge 
    ) 
  ) 
  (princ) 
)

st788796 · 发表于 2014-11-1 21:01:48

hzj268 发表于 2014-11-1 14:53
还是老大善解人意,不过标注出来的有点乱不知道可以解决不,不过.

标注是临时加入的

(defun c:tt (/ fl lst p c1 c2 normal cc3d l1 l2 l3 l4 l5 p nlst tf bp)
(defun _makerotate (pts /)
(mapcar '(lambda (x y / dm)
(setq dm (xdrx_dimension_makerotate
x
y
(xdrx_line_midp x y)
(angle x y)
) ;_字高随当前样式
)
(xdrx_setpropertyvalue
dm "DIMBLK1" "_None" "DIMBLK2" "_None"
"DIMSAH" T "DIMSD1" T "DIMSD2"
T "DIMSE1" T "DIMSE2" T
)
dm
)
pts
(cdr pts)
)
)
(if (and (setq fl (getfiled "Select txt" "" "txt" 8))
(setq lst (xd::list:fromfile fl))
(setq p (getpoint "\nbase point: "))
)
(progn
(setq lst (mapcar 'distof lst))
(while lst
(mapcar 'set '(l1 l2 l3 l4 l5) lst)
(setq nlst (cons (list l1 l2 l3 l4 l5) nlst)
lst (cdr (cddddr lst))
)
) ;_处理边长分组
(setq c1 (xdge::constructor "kCircArc3d") ;_默认圆1
c2 (xdge::constructor "kCircArc3d") ;_默认圆2
normal '(0.0 0.0 1.0)
cc3d (xdge::constructor "kCurveCurveInt3d") ;_建立相交体
)
(mapcar
'(lambda (x / p1 p2 p3 box l1 l2 l3 l4 l5 pl vx ln dm dm1)
(mapcar 'set '(l1 l2 l3 l4 l5) x)
(setq p3 (polar p 0. l4))
(xdge::setpropertyvalue c1 "set" p normal l1) ;_重新设置圆心半径
(xdge::setpropertyvalue c2 "set" p3 normal l5) ;_重新设置圆心半径
(xdge::setpropertyvalue cc3d "set" c1 c2 normal) ;_设置相交体为 c1 c2
(setq p1 (car (vl-remove-if-not
'(lambda (a)
(minusp (xdrx_point_dist2line a p p3)) ;_仅保留上部的交点
)
(xdge::getpropertyvalue cc3d "intPoints") ;_两圆交点
)
)
)
(xdge::setpropertyvalue c1 "set" p1 normal l2) ;_重新设置圆1
(xdge::setpropertyvalue c2 "set" p3 normal l3) ;_重新设置圆2
(setq p2 (car (vl-remove-if-not
'(lambda (a)
(minusp (xdrx_point_dist2line a p1 p3)) ;_仅保留斜线左侧点
)
(xdge::getpropertyvalue cc3d "intPoints") ;_重新取得相交体交点
)
)
pl (xdrx_polyline_make t p p1 p2 p3)
box (xdrx_entity_box pl)
ln (xdrx_line_make p1 p3)
dm (_makerotate (list p p1 p2 p3 p p1 p3))
)
(if bp
(progn
(xdrx_entity_move (cons pl (cons ln dm)) (car box) bp) ;_移动
(setq bp (mapcar '+
bp
(mapcar '- (cadr box) (car box))
'(300. 0. 0.)
)
)
)
(setq bp (polar (cadr box) 0. 300))
)
(setq tf t)
)
(reverse nlst)
)
(xdge::free) ;_释放 Ge
)
)
(princ)
)

(defun c:tt (/ fl lst p c1 c2 normal cc3d l1 l2 l3 l4 l5 p nlst tf bp) 
  (defun _makerotate (pts /) 
    (mapcar '(lambda (x y / dm) 
               (setq dm        (xdrx_dimension_makerotate 
                          x 
                          y 
                          (xdrx_line_midp x y) 
                          (angle x y) 
                        ) ;_字高随当前样式 
               ) 
               (xdrx_setpropertyvalue 
                 dm           "DIMBLK1" "_None"   "DIMBLK2" "_None" 
                 "DIMSAH"  T             "DIMSD1"  T         "DIMSD2" 
                 T           "DIMSE1"  T               "DIMSE2"         T 
                ) 
               dm 
             ) 
            pts 
            (cdr pts) 
    ) 
  ) 
  (if (and (setq fl (getfiled "Select txt" "" "txt" 8)) 
           (setq lst (xd::list:fromfile fl)) 
           (setq p (getpoint "\nbase point: ")) 
      ) 
    (progn 
      (setq lst (mapcar 'distof lst)) 
      (while lst 
        (mapcar 'set '(l1 l2 l3 l4 l5) lst) 
        (setq nlst (cons (list l1 l2 l3 l4 l5) nlst) 
              lst  (cdr (cddddr lst)) 
        ) 
      ) ;_处理边长分组 
      (setq c1           (xdge::constructor "kCircArc3d") ;_默认圆1 
            c2           (xdge::constructor "kCircArc3d") ;_默认圆2 
            normal '(0.0 0.0 1.0) 
            cc3d   (xdge::constructor "kCurveCurveInt3d") ;_建立相交体 
      ) 
      (mapcar 
        '(lambda (x / p1 p2 p3 box l1 l2 l3 l4 l5 pl vx ln dm dm1) 
           (mapcar 'set '(l1 l2 l3 l4 l5) x) 
           (setq p3 (polar p 0. l4)) 
           (xdge::setpropertyvalue c1 "set" p normal l1) ;_重新设置圆心半径 
           (xdge::setpropertyvalue c2 "set" p3 normal l5) ;_重新设置圆心半径 
           (xdge::setpropertyvalue cc3d "set" c1 c2 normal) ;_设置相交体为 c1 c2 
           (setq p1 (car (vl-remove-if-not 
                           '(lambda (a) 
                              (minusp (xdrx_point_dist2line a p p3)) ;_仅保留上部的交点 
                            ) 
                           (xdge::getpropertyvalue cc3d "intPoints") ;_两圆交点 
                         ) 
                    ) 
           ) 
           (xdge::setpropertyvalue c1 "set" p1 normal l2) ;_重新设置 圆1 
           (xdge::setpropertyvalue c2 "set" p3 normal l3) ;_重新设置 圆2 
           (setq p2  (car (vl-remove-if-not 
                            '(lambda (a) 
                               (minusp (xdrx_point_dist2line a p1 p3)) ;_仅保留斜线左侧点 
                             ) 
                            (xdge::getpropertyvalue cc3d "intPoints") ;_重新取得相交体交点 
                          ) 
                     ) 
                  
                 pl  (xdrx_polyline_make t p p1 p2 p3) 
                 box (xdrx_entity_box pl) 
                 ln  (xdrx_line_make p1 p3) 
                 dm  (_makerotate (list p p1 p2 p3 p p1 p3)) 
           ) 
           (if bp 
             (progn 
               (xdrx_entity_move (cons pl (cons ln dm)) (car box) bp) ;_移动 
               (setq bp        (mapcar        '+ 
                                bp 
                                (mapcar '- (cadr box) (car box)) 
                                '(300. 0. 0.) 
                        ) 
               ) 
             ) 
             (setq bp (polar (cadr box) 0. 300)) 
           ) 
           (setq tf t) 
         ) 
        (reverse nlst) 
      ) 
      (xdge::free) ;_释放 Ge 
    ) 
  ) 
  (princ) 
)

hzj268 · 发表于 2014-11-1 14:53:17

:)还是老大善解人意,不过标注出来的有点乱不知道可以解决不,不过.

txc6853234 · 发表于 2014-11-1 20:32:34

像大神学习了。比我些的简洁，高效！

hzj268 · 发表于 2014-11-2 15:27:31

st788796 发表于 2014-11-1 21:01
标注是临时加入的

老大问题已解决.

freedake · 发表于 2014-11-3 08:29:27

很有用，我先学习一下代码……

freedake · 发表于 2014-11-5 16:16:33

st788796 发表于 2014-11-1 21:01
标注是临时加入的

(defun c:tt (/ fl lst p c1 c2 normal cc3d l1 l2 l3 l4 l5 p nlst tf bp)
(defun _makerotate (pts /)
(mapcar '(lambda (x y / dm)
(setq dm (xdrx_dimension_makerotate
x
y
(xdrx_line_midp x y)
(angle x y)
) ;_字高随当前样式
)
(xdrx_setpropertyvalue
dm "DIMBLK1" "_None" "DIMBLK2" "_None"
"DIMSAH" T "DIMSD1" T "DIMSD2"
T "DIMSE1" T "DIMSE2" T
)
dm
)
pts
(cdr pts)
)
)
(if (and (setq fl (getfiled "Select txt" "" "txt" 8))
(setq lst (xd::list:fromfile fl))
(setq p (getpoint "\nbase point: "))
)
(progn
(setq lst (mapcar 'distof lst))
(while lst
(mapcar 'set '(l1 l2 l3 l4 l5) lst)
(setq nlst (cons (list l1 l2 l3 l4 l5) nlst)
lst (cdr (cddddr lst))
)
) ;_处理边长分组
(setq c1 (xdge::constructor "kCircArc3d") ;_默认圆1
c2 (xdge::constructor "kCircArc3d") ;_默认圆2
normal '(0.0 0.0 1.0)
cc3d (xdge::constructor "kCurveCurveInt3d") ;_建立相交体
)
(mapcar
'(lambda (x / p1 p2 p3 box l1 l2 l3 l4 l5 pl vx ln dm dm1)
(mapcar 'set '(l1 l2 l3 l4 l5) x)
(setq p3 (polar p 0. l2))
(xdge::setpropertyvalue c1 "set" p normal l1) ;_重新设置圆心半径
(xdge::setpropertyvalue c2 "set" p3 normal l5) ;_重新设置圆心半径
(xdge::setpropertyvalue cc3d "set" c1 c2 normal) ;_设置相交体为 c1 c2
(setq p1 (car (vl-remove-if-not
'(lambda (a)
(minusp (xdrx_point_dist2line a p p3)) ;_仅保留上部的交点
)
(xdge::getpropertyvalue cc3d "intPoints") ;_两圆交点
)
)
)
(xdge::setpropertyvalue c1 "set" p normal l4) ;_重新设置圆1
(xdge::setpropertyvalue c2 "set" p3 normal l3) ;_重新设置圆2
(setq p2 (car (vl-remove-if-not
'(lambda (a)
(minusp (xdrx_point_dist2line a p p3)) ;_仅保留斜线左侧点
)
(xdge::getpropertyvalue cc3d "intPoints") ;_重新取得相交体交点
)
)
pl (xdrx_polyline_make t p p1 p3 p p2 p3)
box (xdrx_entity_box pl)
ln (xdrx_line_make p1 p2)
dm (_makerotate (list p p1 p2 p3 p p2 p3 p1 ))
)
(if bp
(progn
(xdrx_entity_move (cons pl (cons ln dm)) (car box) bp) ;_移动
(setq bp (mapcar '+
bp
(mapcar '- (cadr box) (car box))
'(300. 0. 0.)
)
)
)
(setq bp (polar (cadr box) 0. 300))
)
(setq tf t)
)
(reverse nlst)
)
(xdge::free) ;_释放 Ge
)
)
(princ)
)

(defun c:tt (/ fl lst p c1 c2 normal cc3d l1 l2 l3 l4 l5 p nlst tf bp) 
  (defun _makerotate (pts /) 
    (mapcar '(lambda (x y / dm) 
               (setq dm        (xdrx_dimension_makerotate 
                          x 
                          y 
                          (xdrx_line_midp x y) 
                          (angle x y) 
                        ) ;_字高随当前样式 
               ) 
               (xdrx_setpropertyvalue 
                 dm           "DIMBLK1" "_None"   "DIMBLK2" "_None" 
                 "DIMSAH"  T             "DIMSD1"  T         "DIMSD2" 
                 T           "DIMSE1"  T               "DIMSE2"         T 
                ) 
               dm 
             ) 
            pts 
            (cdr pts) 
    ) 
  ) 
  (if (and (setq fl (getfiled "Select txt" "" "txt" 8)) 
           (setq lst (xd::list:fromfile fl)) 
           (setq p (getpoint "\nbase point: ")) 
      ) 
    (progn 
      (setq lst (mapcar 'distof lst)) 
      (while lst 
        (mapcar 'set '(l1 l2 l3 l4 l5) lst) 
        (setq nlst (cons (list l1 l2 l3 l4 l5) nlst) 
              lst  (cdr (cddddr lst)) 
        ) 
      ) ;_处理边长分组 
      (setq c1           (xdge::constructor "kCircArc3d") ;_默认圆1 
            c2           (xdge::constructor "kCircArc3d") ;_默认圆2 
            normal '(0.0 0.0 1.0) 
            cc3d   (xdge::constructor "kCurveCurveInt3d") ;_建立相交体 
      ) 
      (mapcar 
        '(lambda (x / p1 p2 p3 box l1 l2 l3 l4 l5 pl vx ln dm dm1) 
           (mapcar 'set '(l1 l2 l3 l4 l5) x) 
           (setq p3 (polar p 0. l2)) 
           (xdge::setpropertyvalue c1 "set" p normal l1) ;_重新设置圆心半径 
           (xdge::setpropertyvalue c2 "set" p3 normal l5) ;_重新设置圆心半径 
           (xdge::setpropertyvalue cc3d "set" c1 c2 normal) ;_设置相交体为 c1 c2 
           (setq p1 (car (vl-remove-if-not 
                           '(lambda (a) 
                              (minusp (xdrx_point_dist2line a p p3)) ;_仅保留上部的交点 
                            ) 
                           (xdge::getpropertyvalue cc3d "intPoints") ;_两圆交点 
                         ) 
                    ) 
           ) 
           (xdge::setpropertyvalue c1 "set" p normal l4) ;_重新设置 圆1 
           (xdge::setpropertyvalue c2 "set" p3 normal l3) ;_重新设置 圆2 
           (setq p2  (car (vl-remove-if-not 
                            '(lambda (a) 
                               (minusp (xdrx_point_dist2line a p p3)) ;_仅保留斜线左侧点 
                             ) 
                            (xdge::getpropertyvalue cc3d "intPoints") ;_重新取得相交体交点 
                          ) 
                     ) 
 
                 pl  (xdrx_polyline_make t p p1 p3 p p2 p3) 
                 box (xdrx_entity_box pl) 
                 ln  (xdrx_line_make p1 p2) 
                 dm  (_makerotate (list p p1 p2 p3 p p2 p3 p1 )) 
           ) 
           (if bp 
             (progn 
               (xdrx_entity_move (cons pl (cons ln dm)) (car box) bp) ;_移动 
               (setq bp        (mapcar        '+ 
                                bp 
                                (mapcar '- (cadr box) (car box)) 
                                '(300. 0. 0.) 
                        ) 
               ) 
             ) 
             (setq bp (polar (cadr box) 0. 300)) 
           ) 
           (setq tf t) 
         ) 
        (reverse nlst) 
      ) 
      (xdge::free) ;_释放 Ge 
    ) 
  ) 
  (princ) 
)

通过学习，稍作修改可以得三边+对角线绘制四边形
在此非常感谢st788796！

newer · 发表于 2014-11-5 16:39:34

freedake 发表于 2014-11-5 16:16
通过学习，稍作修改可以得三边+对角线绘制四边形
在此非常感谢st788796！

最好单独发个帖子吧。配下图。

st788796 · 发表于 2014-11-5 17:08:01

第四边怎么约束的?

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

[教学] XDGE几何库应用(28)--根据四边长及对角线数据绘制四边形

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

本帖被以下淘专辑推荐:

点评

点评