日志
LWPOLYLINE添加顶点
;;xh-lwpl-addvertex LWPOLYLINE添加顶点
;;(xh-lwpl-addvertex ename pt)
;;参数: ename 图元名
;; pt 点坐标
;;返回: ename
;; (xh-lwpl-addvertex (car (entsel "\n选择一条多义线:")) (getpoint "\n在多义线上指定一点:"))
(defun xh-lwpl-addvertex (ename pt / a a1 cen dis dxf h h1 i lst pt1 pt2 radius tu tux param)
(if (and (null (xh-position (setq a1 (cons 10 (xh-3d->2d pt))) (setq dxf (entget ename)) 1e-8))
(= "LWPOLYLINE" (cdr (assoc 0 dxf)))
(setq param (vlax-curve-getparamatpoint ename pt))
)
(progn
(setq lst (vl-remove-if-not '(lambda (x) (or (= 10 (car x)) (= 42 (car x)))) dxf)
lst (append lst (list (car lst)))
)
(setq i (* (fix param) 2))
(setq a (mapcar '(lambda (x) (nth x lst)) (list i (1+ i) (+ 2 i))))
(if (= 0.0 (setq tu (cdadr a))) ;_凸度是否为0
(setq a1 (list a1))
(progn (setq pt1 (cdar a)
pt2 (cdaddr a)
dis (distance pt1 pt2) ;_弦长
)
(setq radius (/ (* (+ 1.0 (* tu tu)) dis 0.25) (abs tu)) ;_半径
h (* dis (abs tu) 0.5) ;_弓高
h1 (- radius h)
cen (xh-midp pt1 pt2)
cen (polar cen
(+ (angle pt1 pt2)
(if (or nil (and (> h1 0) (> tu 0)) (and (< h1 0) (< tu 0)))
(* pi 0.5)
(* pi -0.5)
)
)
(abs h1)
) ;_圆心
)
(setq
tux (mapcar '(lambda (x / x1)
(setq x1 (xh-midp x pt))
(/ (distance (polar cen (angle cen x1) radius) x1) (distance pt x1))
)
(list pt1 pt2)
)
)
(and (< tu 0) (setq tux (mapcar '- tux)))
(setq a1 (list (cons 42 (car tux)) a1 (cons 42 (cadr tux))))
)
)
(setq dxf (subst (cons 90 (1+ (cdr (assoc 90 dxf)))) (assoc 90 dxf) dxf))
(entmod (append (xh-sublist dxf 0 (1+ (xh-position (car a) dxf 1e-8)))
a1
(xh-sublist dxf (xh-position (caddr a) dxf 1e-8) (length dxf))
)
)
)
)
ename
)
