本帖最后由 yjtdkj 于 2021-6-28 11:40 编辑
- ;取圆弧凸度-------------yjtdkj by 2021.06
- (defun c:tt ()
- (progn
- (defun yj-dxf (key ename) (cdr (assoc key (entget ename))))
- (defun mid (p1 p2)
- (mapcar (function (lambda (e1 e2) (* (+ e1 e2) 0.5))) p1 p2)
- )
- )
- (setq en (car (entsel)))
- (setq
- r (dxf 40 en)
- pt1 (vlax-curve-getstartPoint en)
- pt2 (vlax-curve-getEndPoint en)
- ptm (mid pt1 pt2)
- len (vlax-curve-getDistAtPoint en (vlax-curve-getEndPoint en))
- cpm (vlax-curve-getpointAtdist en (/ len 2))
- dis (distance pt1 pt2)
- h (distance ptm cpm)
- )
- (setq tu (/ h (* dis 0.5)))
- (setq
- a (-(cadr pt2) (cadr pt1))
- b (-(car pt1)(car pt2))
- c (-(* -1 a (car pt1))(* b (cadr pt1)))
- d1 (-(* -1 a (car cpm))(* b (cadr cpm)))
- )
- (cond
- ((= d1 c)
- (* tu 0)
- )
- ((> d1 c)
- (* tu -1)
- )
- ((< d1 c)
- (* tu 1)
- )
- )
- )
|