圆转PL线, SPL转PL?
本帖最后由 zilong136 于 2024-8-27 00:26 编辑求一份圆、圆弧转PL线的lisp?
SPL转PL?
(defun c:tt ()
"圆、圆弧转PL线"
(if (setq ss (ssget '((0 . "arc,circle")))
i-1
)
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq a (entget s1))
(if (= (cdr (assoc 0 a)) "ARC")
(vl-cmdf "pedit" s1 "")
(progn
(setq p0 (cdr (assoc 10 a))
rr (* (cdr (assoc 40 a)) 2)
)
(command "donut" rr rr "non" p0 "")
(entdel s1)
)
)
)
)
(princ)
) 胡乱写了一个，试试
(defun c:tt(/ en lst n old ss)
(setq lst (list "cmdecho" "peditaccept" "plinewid")
old (mapcar 'getvar lst))
(mapcar 'setvar lst '(0 1 0))
(setq ss (ssget '((0 . "arc,circle"))))
(repeat (setq n (sslength ss))
(setq en (ssname ss (setq n (1- n))))
(if (= "ARC" (cdr (assoc 0 (entget en))))
(vl-cmdf "pedit" en "")
(progn (vl-cmdf "pline"
"non"
(vlax-curve-getstartpoint en)
"a"
"s"
"non"
(vlax-curve-getpointatparam en (* 0.5 pi))
"non"
(vlax-curve-getpointatparam en pi)
"cl")
(entdel en))))
(mapcar 'setvar lst old)
(princ))
[*];圆、弧转2节点多段线-----(一级)------
[*](defun arccirtopl (e / en p r ang1 ang2)
[*](defun arc-cir-topl (p r ang1 ang2 / a)
[*] (setq a (* (rem (+ (- ang2 ang1) 2pi) 2pi) 0.25) a (cons 42 (/ (sin a) (cos a))))
[*] (list (cons 10 (polar p ang1 r)) a (cons 10 (polar p ang2 r)) a)
[*])
[*];;---------
[*](setq
[*] en (entget e)
[*] p (cdr (assoc 10 en))
[*] r (cdr (assoc 40 en))
[*] ang1 (cdr (assoc 50 en))
[*])
[*](entdel e)
[*](entmakex
[*] (vl-remove 'nil
[*] (append
[*] (mapcar 'cons '(0 100 100 90 70) (list "LWPOLYLINE" "AcDbEntity" "AcDbPolyline" 2 (if ang1 0 1)))
[*] (list (assoc 8 en) (assoc 370 en) (assoc 62 en))
[*] (if ang1 (arc-cir-topl p r ang1 (cdr (assoc 51 en))) (arc-cir-topl p r 0 pi))
[*] )
[*] )
[*])
[*])
夏生生 发表于 2024-8-26 09:46
胡乱写了一个，试试
谢谢，可以用，能不能再写个SPL转PL? xyp1964 发表于 2024-8-26 11:37
谢谢，可以用，能不能再写个SPL转PL? zilong136 发表于 2024-8-27 00:28
谢谢，可以用，能不能再写个SPL转PL?
acad现成的splinedit 夏生生 发表于 2024-8-27 08:42
acad现成的splinedit
OK，谢谢。
页:
[1]