[弹指神通]：判断复线上的一个顶点是否为尖点(平滑过度)

舟自横

[PHP]
(defun hy_pointissharp(pline point / obj param deriv-1 deriv)
  (defun count(o num)
    (cond ((< o 0) (+ num o))
          ((> o num) (- o num))
          (t o)
     )
    )
  (setq obj (vlax-ename->vla-object pline)
        param (vlax-curve-getparamatpoint obj point)
        numo (cdr (assoc 90 (entget pline)))
        )
  
  (if(vlax-curve-isclosed pline)
     (progn
     (setq deriv-1 (vlax-curve-getfirstderiv obj (count (- param 1e-10) numo))
           deriv (vlax-curve-getfirstderiv obj param)
        )
     (cond ((and (not (equal (car deriv-1) 0 1e-8)) (not (equal (car deriv) 0 1e-8)))
            (if (equal (/ (cadr deriv-1) (car deriv-1))
             (/ (cadr deriv) (car deriv))
             1e-3)
             t
             nil
            ))
           ((and (equal (car deriv-1) 0 1e-8) (equal (car deriv) 0 1e-8)) t)
           (t nil)
           )
  )
     (if (and (/= param (vlax-curve-getstartparam obj))
              (/= param (vlax-curve-getendparam obj))
              )
       (progn (setq deriv-1 (vlax-curve-getfirstderiv obj (count (- param 1e-10) numo))
                    deriv (vlax-curve-getfirstderiv obj param)
                    )
              (cond ((and (not (equal (car deriv-1) 0 1e-8)) (not (equal (car deriv) 0 1e-8)))
            (if (equal (/ (cadr deriv-1) (car deriv-1))
             (/ (cadr deriv) (car deriv))
             1e-3)
             t
             nil
            ))
           ((and (equal (car deriv-1) 0 1e-8) (equal (car deriv) 0 1e-8)) t)
           (t nil)
           )
          )
       nil)
    )
  )
[/PHP]
测试
(DEFUN C:TT()  
(SETVAR "OSMODE" 1)
(SETQ PLINE (CAR(ENTSEL)) POINT (GETPOINT "选择曲线上一顶点"))
(hy_pointissharp PLINE POINT)
)
如果平滑过度返回T否则返回NIL

狂刀

是个挺有意思的程序,这个程序舟兄你是用在什么地方?

舟自横

一般在我工作中是不允许复线有尖角存在的..
我是用在自动给复线尖角倒圆用的...先判断顶点是否为尖点如果是的话倒为圆角