(XD::Curve:GetSub)获得曲线上的部分曲线

newer · 发表于 2016-6-12 18:49:34

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

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

×

(defun XD::Curve:GetSub (e p1 p2 testPnt / ge1 pa1 pa2 testpa)
(defun _isclose ()
(and
(xdrx_getpropertyvalue e "isclosed")
(or
(>= pa1 testpa)
(<= pa2 testpa)
)
)
)
(defun _trimEnts (ge1 pa1 pa2)
(xdge::setpropertyvalue ge1 "setinterval" pa1 pa2)
ge1
)
(setq ge1 (xdge::constructor e))
(if (= (type p1) 'LIST)
(progn
(setq p1 (trans p1 1 0)
p2 (trans p2 1 0)
)
(if (not testpnt)
(setq testpnt '(0 0 0))
(setq testPnt (trans testpnt 1 0))
)
(setq pa1 (xdge::getpropertyvalue ge1 "paramof" p1)
pa2 (xdge::getpropertyvalue ge1 "paramof" p2)
testPa (xdge::getpropertyvalue ge1 "paramof" testPnt)
)
)
(progn
(setq pa1 p1
pa2 p2
)
(if (not testpnt)
(setq testpa 0.0)
(setq testpa testpnt)
)
)
)
(mapcar
'set
'(pa1 pa2)
(vl-sort (list pa1 pa2) '<)
)
(if (_isclose)
(setq ge1 (_trimEnts ge1 pa2 pa1))
(setq ge1 (_trimEnts ge1 pa1 pa2))
)
ge1
)

(defun XD::Curve:GetSub (e p1 p2 testPnt / ge1 pa1 pa2 testpa) 
  (defun _isclose () 
    (and 
      (xdrx_getpropertyvalue e "isclosed") 
      (or 
        (>= pa1 testpa) 
        (<= pa2 testpa) 
      ) 
    ) 
  ) 
  (defun _trimEnts (ge1 pa1 pa2) 
    (xdge::setpropertyvalue ge1 "setinterval" pa1 pa2) 
    ge1 
  ) 
  (setq ge1 (xdge::constructor e)) 
  (if (= (type p1) 'LIST) 
    (progn 
      (setq p1 (trans p1 1 0) 
            p2 (trans p2 1 0) 
      ) 
      (if (not testpnt) 
        (setq testpnt '(0 0 0)) 
        (setq testPnt (trans testpnt 1 0)) 
      ) 
      (setq pa1 (xdge::getpropertyvalue ge1 "paramof" p1) 
            pa2 (xdge::getpropertyvalue ge1 "paramof" p2) 
            testPa (xdge::getpropertyvalue ge1 "paramof" testPnt) 
      ) 
    ) 
    (progn 
      (setq pa1 p1 
            pa2 p2 
      ) 
      (if (not testpnt) 
        (setq testpa 0.0) 
        (setq testpa testpnt) 
      ) 
    ) 
  ) 
  (mapcar 
    'set 
    '(pa1 pa2) 
    (vl-sort (list pa1 pa2) '<) 
  ) 
  (if (_isclose) 
    (setq ge1 (_trimEnts ge1 pa2 pa1)) 
    (setq ge1 (_trimEnts ge1 pa1 pa2)) 
  ) 
  ge1 
)

newer · 发表于 2016-6-12 18:51:16

本帖最后由 newer 于 2016-6-12 18:54 编辑

测试命令：

(defun c:tt ()
(if (and
(setq e (car (xdrx_entsel "\n选取多段线<退出>:" '((0 . "LWPOLYLINE,arc,circle,ellipse,line,spline")))))
(setq spt (xdrx_getpropertyvalue e "startpoint"))
(xdrx_grdraw 2 0 spt 3 4)
(setq p1 (getpoint "\n起点<退出>:"))
(setq p2 (getpoint p1 "\n终点<退出>:"))
(if (xdrx_curve_isclosed e)
(setq p3 (getpoint "\n保留的方向点一点<退出>:"))
t
)
)
(progn
(xdrx_begin)
(xdrx_sysvar_push '("osmode" 512))
(setq g (xd::curve:getsub e p1 p2 p3))
(xdge::entity:make g) (xdge::free g)
(xdrx_sysvar_pop)
(xdrx_end)
)
)
(princ)
)

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

[曲线] (XD::Curve:GetSub)获得曲线上的部分曲线

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