【K:CalcPlineBulge】计算多段线上目标点两侧的新凸度

kucha007 · 发表于 2023-12-6 11:37

本帖最后由 kucha007 于 2023-12-6 12:27 编辑

主要用于打断圆弧时，保持弧度不变。
该函数已用在此程序中：http://bbs.mjtd.com/thread-189001-1-1.html

关于凸度的资料：
https://www.cnblogs.com/JJBox/articles/15863558.html
http://www.lee-mac.com/bulgeconversion.html
http://bbs.mjtd.com/thread-183667-1-1.html

;计算多段线中某一段线上目标点两侧的新凸度
;Obj Vla对象
;TgtNum 多段线上目标点的参数,必须大于0
(defun K:CalcPlineBulge (Obj TgtNum / IsNeg Rad Len1 Len2 BLG1 BLG2)
(if
(and
(eq (type Obj) 'VLA-OBJECT)
(> TgtNum 0);大于0
(>= TgtNum (setq StaNum (fix TgtNum)) )
(vlax-method-applicable-p obj 'getbulge)
(setq TgtBG (vla-getbulge obj StaNum))
)
(cond
((= StaNum TgtNum);多段线顶点
(list
(vla-getbulge obj (1- StaNum))
(vla-getbulge obj StaNum)
)
)
((= TgtBG 0.0);直线段
(list 0.0 0.0)
)
((/= TgtBG 0.0);弧线段
(setq IsNeg (if (minusp TgtBG) -1 1))
(setq Rad (distance '(0.0 0.0 0.0) (vlax-curve-getsecondderiv Obj StaNum)));圆弧半径
(setq Len1 (*
0.5
(distance
(vlax-curve-getpointatparam Obj StaNum)
(vlax-curve-getpointatparam Obj TgtNum)
)
)
Len2 (*
0.5
(distance
(vlax-curve-getpointatparam Obj TgtNum)
(vlax-curve-getpointatparam Obj (+ 1.0 StaNum))
)
)
);1/2弦长
(setq BLG1 (/ (- Rad (sqrt (- (expt Rad 2) (expt Len1 2)))) Len1)
BLG2 (/ (- Rad (sqrt (- (expt Rad 2) (expt Len2 2)))) Len2)
);拱高除以1/2弦长=凸度
(list (* IsNeg BLG1) (* IsNeg BLG2))
)
)
)
)

;计算多段线中某一段线上目标点两侧的新凸度 
;Obj Vla对象 
;TgtNum  多段线上目标点的参数,必须大于0 
(defun K:CalcPlineBulge (Obj TgtNum / IsNeg Rad Len1 Len2 BLG1 BLG2) 
  (if 
      (and 
          (eq (type Obj) 'VLA-OBJECT) 
          (> TgtNum 0);大于0 
          (>= TgtNum (setq StaNum (fix TgtNum)) ) 
          (vlax-method-applicable-p obj 'getbulge) 
          (setq TgtBG (vla-getbulge obj StaNum)) 
      ) 
      (cond 
        ((= StaNum TgtNum);多段线顶点 
          (list 
            (vla-getbulge obj (1- StaNum)) 
            (vla-getbulge obj StaNum) 
          ) 
        ) 
        ((= TgtBG 0.0);直线段 
          (list 0.0 0.0) 
        ) 
        ((/= TgtBG 0.0);弧线段 
            (setq IsNeg (if (minusp TgtBG) -1 1)) 
            (setq Rad (distance '(0.0 0.0 0.0) (vlax-curve-getsecondderiv Obj StaNum)));圆弧半径 
            (setq Len1 (* 
                        0.5 
                        (distance 
                          (vlax-curve-getpointatparam Obj StaNum) 
                          (vlax-curve-getpointatparam Obj TgtNum) 
                        ) 
                      ) 
                  Len2 (* 
                        0.5 
                        (distance 
                          (vlax-curve-getpointatparam Obj TgtNum) 
                          (vlax-curve-getpointatparam Obj (+ 1.0 StaNum)) 
                        ) 
                      ) 
            );1/2弦长 
            (setq BLG1 (/ (- Rad (sqrt (- (expt Rad 2) (expt Len1 2)))) Len1) 
                  BLG2 (/ (- Rad (sqrt (- (expt Rad 2) (expt Len2 2)))) Len2) 
            );拱高除以1/2弦长=凸度 
            (list (* IsNeg BLG1) (* IsNeg BLG2)) 
        ) 
      ) 
  ) 
)

用法示意：

(K:CalcPlineBulge (Vlax-Ename->Vla-Object (Car(Entsel))) 0.5)

magicheno · 发表于 2023-12-6 13:21

感谢大佬分享源码

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