[LISP函数]：细分圆弧成多仪线

puzhixing123

;将圆弧转化成多段线
(Defun C:ARC-P ( / star_jd end_jd circle_point star_point end_point pt0)                               
  (command "undo" "be")
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (prompt "\n 程序功能：将圆弧转化成多段线")
  (setq sn (getreal "\n输入近似多段线的单位长度<3.0>: "))
  (if (= sn nil)
    (setq sn 3.0)
  )
  (setq xzj nil)
  (setq n 0)
  (initget "1 2")
  (prompt "\n 请选择对象的处理方式")
  (setq stret (getstring "\n   1:手工单选  /2:自动过滤选择<1>:"))
  (if (= stret "")
      (setq stret "1")
  )
  (cond ((= stret "1")
         (progn
           (prompt"\n 请选择需转换的对象：")
           (setq xzj (ssget))
         )  
        )
        ((= stret "2")
         (setq xzj (ssget "X" (list (cons 0 "ARC"))))
        )
  )
  (princ"\n 正在进行转换，请等待...")
  (while xzj
    (repeat (sslength xzj)
      (setq oldlay (getvar "clayer"))
      (setq oldlty (getvar "celtype"))
      (setq oldltw (getvar "celweight"))      
      (setq ss (entget (ssname xzj n)'("*")))
      (setq kzsj0 (assoc -3 ss))
      (if (/= kzsj0 nil)
          (setq kzsj (list (assoc -3 ss)))
          (setq kzsj0 "0")
      )
      (setq lty (cdr (assoc 6 ss)))
      (setq lay (cdr (assoc 8 ss)))
      (setq ltw (cdr (assoc 39 ss)))
      (setq star_jd (cdr (assoc 50 ss)))        ;获取起点角度
      (setq end_jd (cdr (assoc 51 ss)))        ;获取终点角度
      (setq circle_point (list (cadr (assoc 10 ss)) (caddr (assoc 10 ss))))
                                        ;获取圆心点坐标
      (setq star_point (polar circle_point star_jd (cdr (assoc 40 ss))))
                                        ;起点坐标
      (setq end_point (polar circle_point end_jd (cdr (assoc 40 ss))))
                                        ;起点坐标
      (command "layer" "m" "df-point" "")
      (command "measure" star_point sn)
      ;(command "_.erase" star_point "")
      (command "_.erase" (ssname xzj n) "")
      (setq ssp nil)
      (setq i 0)
      (setq ssp (ssget "x" '((8 . "df-point") (0 . "POINT"))))
      (setq newpl nil)
      (while ssp
        (repeat (sslength ssp)
          (setq dfd (cdr (assoc 10 (entget (ssname ssp i)))))
          (setq newpl (cons dfd newpl))
          (setq i (1+ i))
        );r
        (command "_.erase" ssp "")
        (setq ssp nil)
       )  ;w  
     (setq i 0)
     (command "clayer" lay "celtype" lty "celweight" ltw "cecolor" "bylayer")
     ;(command "clayer" lay "celtype" lty "cecolor" "bylayer")
     (command "pline")
     (setq pt0 star_point)
     (command pt0)
     (while
        (setq pt (nth i newpl))
        (command pt)
        (setq pt0 pt)
        (setq i (1+ i))
     )
     (setq pt0 end_point)
     (command pt0)
     (command)
     (setq newpl nil)
     (if (/= kzsj0 "0")
       (progn
         (setq endata (entget(entlast)))
         (setq newdata (append endata kzsj))
         (entmod newdata)
         (entupd (entlast))
       )
     )
     (redraw)  
     (setvar "clayer" oldlay)
     (setvar "celtype" oldlty)
     (setvar "celweight" oldltw)
     (setq n (1+ n))
   );r
(setq xzj nil)
);w
(princ "\n***OK!共转换了")
(princ n)
(princ "个\"圆弧\"对象***")
  (command "undo" "e")
  (princ)
)                                        ;defun