（XD::Polyline:DivideAtSeg）多段线每段单独取等分点

newer · 发表于 2018-1-2 10:10:59

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

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

×

本帖最后由 newer 于 2018-1-2 10:21 编辑

(defun XD::Polyline:DivideAtSeg (poly div / div1 g len pts segs x isge)
(if (or
(and
(= (xdge::type poly) "kCompositeCrv3d")
(setq g poly
isge t
)
)
(setq g (xdge::constructor poly))
)
(progn
(setq segs (xdge::getpropertyvalue g "getcurvelist"))
(setq pts (apply
'append
(mapcar
'(lambda (x)
(setq div1 div)
(if (= (type div) 'REAL)
(setq len (xdge::getpropertyvalue x "length")
div1 (fix (/ len div))
)
)
(xdge::getpropertyvalue x "getsamplepoints"
(1+ div1)
)
)
segs
)
)
)
(if (not isge)
(xdge::free g)
)
(xdge::free segs)
)
)
pts
)

(defun XD::Polyline:DivideAtSeg (poly div / div1 g len pts segs x isge) 
  (if (or 
        (and 
          (= (xdge::type poly) "kCompositeCrv3d") 
          (setq g poly 
                isge t 
          ) 
        ) 
        (setq g (xdge::constructor poly)) 
      ) 
    (progn 
      (setq segs (xdge::getpropertyvalue g "getcurvelist")) 
      (setq pts (apply 
                  'append 
                  (mapcar 
                    '(lambda (x) 
                       (setq div1 div) 
                       (if (= (type div) 'REAL) 
                         (setq len (xdge::getpropertyvalue x "length") 
                               div1 (fix (/ len div)) 
                         ) 
                       ) 
                       (xdge::getpropertyvalue x "getsamplepoints" 
                                               (1+ div1) 
                       ) 
                     ) 
                    segs 
                  ) 
                ) 
      ) 
      (if (not isge) 
        (xdge::free g) 
      ) 
      (xdge::free segs) 
    ) 
  ) 
  pts 
)

应用例子：

(defun c:tt ()
(if
(and (xdrx_initssget "选择多段线<退出>:")
(setq ss (xdrx_ssget '((0 . "LWPOLYLINE"))))
(/= ""
(setq div (getstring "\n输入每段等分数（实数等分距离）<退出>:"))
)
)
(progn
(if (xdrx_string_regexps "^[0-9.]+$" div)
(progn (if (xdrx_string_regexps "^[0-9]+$" div)
(setq div (atoi div))
(setq div (atof div))
)
(mapcar '(lambda (x)
(setq pts (xd::polyline:divideatseg x div))
(mapcar '(lambda (y) (xdrx_grdraw 2 0 y 3 2)) pts)
)
(xdrx_pickset->ents ss)
)
)
)
)
)
(princ)
)

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

[多段线] （XD::Polyline:DivideAtSeg）多段线每段单独取等分点

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