马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
便于后续处理, 返回曲线及交点处参数
- (defun c:tt (/ ss pts lst _removedup)
- (defun _removedup (lst / nl)
- (while lst
- (if nl
- (if (equal (car lst) (car nl) 1e-3)
- (setq lst (cdr lst))
- (setq nl (cons (car lst) nl)
- lst (cdr lst)
- )
- )
- (setq nl (cons (car lst) nl)
- lst (cdr lst)
- )
- )
- )
- (reverse nl)
- )
- (if (setq ss (ssget '((0 . "line"))))
- (progn
- (setq pts (xdrx_curve_getinters ss 0)
- lst (xdrx_pickset->ents ss)
- lst (vl-remove
- nil
- (mapcar '(lambda (e / npl)
- (if (setq npl (vl-remove-if-not
- '(lambda (p) (xdrx_point_ison p e))
- pts
- )
- )
- (cons e npl)
- nil
- )
- )
- lst
- )
- )
- lst (vl-remove-if
- '(lambda (c)
- (not (cadr c))
- );_去除交点是端点的线
- (mapcar
- '(lambda (x)
- (cons
- (car x)
- (vl-remove-if
- '(lambda (a)
- (or (equal
- (xdrx_curve_getstartparam
- (car x)
- )
- a
- 1e-3
- )
- (equal
- (xdrx_curve_getendparam
- (car x)
- )
- a
- 1e-3
- )
- )
- );_去除端点
- (_removedup
- (vl-sort
- (mapcar
- '(lambda (b)
- (xdrx_curve_getparamatpoint
- (car x)
- b
- )
- )
- (cdr x)
- )
- '<
- )
- );_消除重点
- )
- )
- )
- lst
- )
- )
- )
- )
- )
- (princ lst)
- (princ)
- )
|