圆转PL线, SPL转PL?

zilong136

求一份圆、圆弧转PL线的lisp?
                          SPL转PL?

xyp1964

1. (defun c:tt ()
   
2.   "圆、圆弧转PL线"
   
3.   (if (setq ss (ssget '((0 . "arc,circle")))
   
4.             i  -1
   
5.       )
   
6.     (while (setq s1 (ssname ss (setq i (1+ i))))
   
7.       (setq a (entget s1))
   
8.       (if (= (cdr (assoc 0 a)) "ARC")
   
9.         (vl-cmdf "pedit" s1 "")
   
10.         (progn
    
11.           (setq p0 (cdr (assoc 10 a))
    
12.                 rr (* (cdr (assoc 40 a)) 2)
    
13.           )
    
14.           (command "donut" rr rr "non" p0 "")
    
15.           (entdel s1)
    
16.         )
    
17.       )
    
18.     )
    
19.   )
    
20.   (princ)
    
21. )

(defun c:tt ()<br />   "圆、圆弧转PL线"<br />   (if (setq ss (ssget '((0 . "arc,circle")))<br />             i  -1<br />       )<br />     (while (setq s1 (ssname ss (setq i (1+ i))))<br />       (setq a (entget s1))<br />       (if (= (cdr (assoc 0 a)) "ARC")<br />         (vl-cmdf "pedit" s1 "")<br />         (progn<br />           (setq p0 (cdr (assoc 10 a))<br />                 rr (* (cdr (assoc 40 a)) 2)<br />           )<br />           (command "donut" rr rr "non" p0 "")<br />           (entdel s1)<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

夏生生

胡乱写了一个，试试

1. (defun c:tt  (/ en lst n old ss)
   
2. (setq lst (list "cmdecho" "peditaccept" "plinewid")
   
3.        old (mapcar 'getvar lst))
   
4. (mapcar 'setvar lst '(0 1 0))
   
5. (setq ss (ssget '((0 . "arc,circle"))))
   
6. (repeat (setq n (sslength ss))
   
7.   (setq en (ssname ss (setq n (1- n))))
   
8.   (if (= "ARC" (cdr (assoc 0 (entget en))))
   
9.    (vl-cmdf "pedit" en "")
   
10.    (progn (vl-cmdf "pline"
    
11.                    "non"
    
12.                    (vlax-curve-getstartpoint en)
    
13.                    "a"
    
14.                    "s"
    
15.                    "non"
    
16.                    (vlax-curve-getpointatparam en (* 0.5 pi))
    
17.                    "non"
    
18.                    (vlax-curve-getpointatparam en pi)
    
19.                    "cl")
    
20.           (entdel en))))
    
21. (mapcar 'setvar lst old)
    
22. (princ))

(defun c:tt  (/ en lst n old ss)<br /> (setq lst (list "cmdecho" "peditaccept" "plinewid")<br />        old (mapcar 'getvar lst))<br /> (mapcar 'setvar lst '(0 1 0))<br /> (setq ss (ssget '((0 . "arc,circle"))))<br /> (repeat (setq n (sslength ss))<br />   (setq en (ssname ss (setq n (1- n))))<br />   (if (= "ARC" (cdr (assoc 0 (entget en))))<br />    (vl-cmdf "pedit" en "")<br />    (progn (vl-cmdf "pline"<br />                    "non"<br />                    (vlax-curve-getstartpoint en)<br />                    "a"<br />                    "s"<br />                    "non"<br />                    (vlax-curve-getpointatparam en (* 0.5 pi))<br />                    "non"<br />                    (vlax-curve-getpointatparam en pi)<br />                    "cl")<br />           (entdel en))))<br /> (mapcar 'setvar lst old)<br /> (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))
•       )
•     )
•   )
• )
  

zilong136

夏生生 发表于 2024-8-26 09:46
胡乱写了一个，试试

谢谢，可以用，能不能再写个SPL转PL?

zilong136

xyp1964 发表于 2024-8-26 11:37

谢谢，可以用，能不能再写个SPL转PL?

夏生生

zilong136 发表于 2024-8-27 00:28
谢谢，可以用，能不能再写个SPL转PL?

acad现成的splinedit

zilong136

夏生生 发表于 2024-8-27 08:42
acad现成的splinedit

OK，谢谢。