- 积分
- 3618
- 明经币
- 个
- 注册时间
- 2020-6-21
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
楼主 |
发表于 2024-5-2 18:46:50
|
显示全部楼层
已解决,代码如下
(defun C:Z4 ( / ss en n nn P1 P2 P3 P4 P5)
(vl-load-com)
(princ "\n封闭多段线内画圆")
(defun exit_msg (msg)
(princ (STRCAT "\n" msg))
(vl-exit-with-value "")
)
(DEFUN TAO-GET-LENGTH (ENT)
(if (= (TYPE ENT) 'ENAME)
(PROGN (setq ENT (vlax-ename->vla-object ENT)))
)
(if
(WCMATCH
(vla-get-ObjectName ENT)
"AcDbPolyline,AcDbEllipse,AcDbCircle,AcDbArc,AcDbLine,AcDb2dPolyline,AcDbSpline"
)
(PROGN
(vlax-curve-getDistAtParam ENT (vlax-curve-getEndParam ENT))
)
)
)
;;//////////////////////////////////
(defun entselEx (msg fil ermsg / el ss)
(while (and (setvar "errno" 0)
(not (and (setq el (entsel msg))
(if (= (type el) 'str)
el
(if (setq ss (ssget (cadr el) fil))
ss
(progn (princ ermsg) (setq ss nil))
)
)
)
)
(/= (getvar "errno") 52)
)
)
el
)
;;//////////////////////////////////
(setq dd 2.0)
(setvar "cmdecho" 0)
(setq ss (entselEx "\n选择多段线:" '((0 . "LWPOLYLINE")) "\n所选对像不符合要求!请重新选择:"))
(setq en (car ss));;多段线图元名
(setq obj (vlax-ename->vla-object en));;obj
(if (not(vlax-curve-isClosed obj))(exit_msg "所选多段线未闭合,请重新选择!!!"))
(setq len (tao-get-length en));;多段线长度
(setq n(vlax-curve-getclosestpointto en (cadr ss)));;点在多段线上的一点
(setq nn(fix (vlax-curve-getparamatpoint en n)));点选在多段线上的第几段
(setq offsetplineObj (car (vlax-safearray->list(vlax-variant-value(vla-OFFSET obj 0.0001)))))
(setq bulge(vla-getbulge obj nn));;多段线凸度值
(setq P1(trans (vlax-curve-getpointatparam en nn) 0 1));第一个端点坐标
(setq P2(trans (vlax-curve-getpointatparam en (1+ nn)) 0 1));第二个端点坐标
(setq P3(polar P1 (angle P1 P2) (* 0.5 (distance P1 P2))));线段中点坐标
(if (> (vlax-curve-getdistatparam obj (vlax-curve-getEndParam obj))
(vlax-curve-getdistatparam offsetplineObj (vlax-curve-getEndParam offsetplineObj))
)
(progn
(princ "\n顺时针")
(cond
((= bulge 0)
;;(princ "\nG01")
(setq P4(polar P3 (+ (angle P1 P3) (angtof "270")) dd))
(vl-cmdf "CIRCLE" P4 0.5)
;(vl-cmdf "LINE" P3 P4 "")
)
((< bulge 0)
;;(princ "\nG02")
(setq dis(vlax-curve-getdistatpoint obj P1))
(setq dis1(vlax-curve-getdistatpoint obj P2))
(if (= dis1 0)(setq dis1 len))
(setq dis2(+ dis (/ (- dis1 dis) 2)))
(setq P4(vlax-curve-getpointatdist obj dis2))
(setq P5(polar P3 (+ (angle P1 P3) (angtof "270")) (- dd (distance P3 P4))))
(vl-cmdf "CIRCLE" P5 0.5)
;(vl-cmdf "LINE" P4 P5 "")
)
((> bulge 0)
;;(princ "\nG03")
(setq dis(vlax-curve-getdistatpoint obj P1))
(setq dis1(vlax-curve-getdistatpoint obj P2))
(if (= dis1 0)(setq dis1 len))
(setq dis2(+ dis (/ (- dis1 dis) 2)))
(setq P4(vlax-curve-getpointatdist obj dis2))
(setq P5(polar P3 (+ (angle P1 P3) (angtof "270")) (+ dd (distance P3 P4))))
(vl-cmdf "CIRCLE" P5 0.5)
(vl-cmdf "LINE" P4 P5 "")
)
)
)
(progn
(princ "\n逆时针")
(cond
((= bulge 0)
;;(princ "\nG01")
(setq P4(polar P3 (+ (angle P1 P3) (angtof "90")) dd))
(vl-cmdf "CIRCLE" P4 0.5)
;(vl-cmdf "LINE" P3 P4 "")
)
((< bulge 0)
;;(princ "\nG02")
(setq dis(vlax-curve-getdistatpoint obj P1))
(setq dis1(vlax-curve-getdistatpoint obj P2))
(if (= dis1 0)(setq dis1 len))
(setq dis2(+ dis (/ (- dis1 dis) 2)))
(setq P4(vlax-curve-getpointatdist obj dis2))
(setq P5(polar P3 (+ (angle P1 P3) (angtof "90")) (+ dd (distance P3 P4))))
(vl-cmdf "CIRCLE" P5 0.5)
;(vl-cmdf "LINE" P4 P5 "")
)
((> bulge 0)
;;(princ "\nG03")
(setq dis(vlax-curve-getdistatpoint obj P1))
(setq dis1(vlax-curve-getdistatpoint obj P2))
(if (= dis1 0)(setq dis1 len))
(setq dis2(+ dis (/ (- dis1 dis) 2)))
(setq P4(vlax-curve-getpointatdist obj dis2))
(setq P5(polar P3 (+ (angle P1 P3) (angtof "90")) (- dd (distance P3 P4))))
(vl-cmdf "CIRCLE" P5 0.5)
;(vl-cmdf "LINE" P4 P5 "")
)
)
)
)
(vla-delete offsetplineObj)
(princ)
) |
|