[编程交流] 多段线、圆、多重和可转义

(defun c:cirpl ( / *error* ch ent dxf_ent pt_cen radius fst_pt opp_pt new_ep ) 
;; ribarm  http://www.theswamp.org/index.php?topic=54622.msg591127#msg591127
(princ "\n Multi Circle Polylined..\n")
  (defun *error* (msg / tmp) ;; kdub.. https://www.theswamp.org/index.php?topic=52933.msg577591#msg577591
      ;;----- Cancel any Active Commands
    (while ( (getvar 'cmdactive) 0) (vl-cmdf "\") ;)
    (progn
      (setq
        ent (entlast)
        dxf_ent (entget ent)
        pt_cen (cdr (assoc 10 dxf_ent))
        radius (cdr (assoc 40 dxf_ent))
        fst_pt (polar pt_cen 0.0 radius)
        opp_pt (polar pt_cen pi radius)
      )
      (entmake
        (vl-remove nil
          (list
            '(0 . "LWPOLYLINE")
            '(100 . "AcDbEntity")
            (assoc 67 dxf_ent)
            (assoc 410 dxf_ent)
            (assoc 8 dxf_ent)
            (if (assoc 6 dxf_ent) (assoc 6 dxf_ent) '(6 . "BYLAYER"))
            (if (assoc 62 dxf_ent) (assoc 62 dxf_ent) '(62 . 256))
            (if (assoc 420 dxf_ent) (assoc 420 dxf_ent))
            (if (assoc 370 dxf_ent) (assoc 370 dxf_ent) '(370 . -3))
            (if (assoc 48 dxf_ent) (assoc 48 dxf_ent) '(48 . 1.0))
            '(100 . "AcDbPolyline")
            '(90 . 2)
            '(70 . 1)
            (cons 43 (getvar "PLINEWID"))
            (cons 38 (caddr pt_cen)) ;; shows error if..
            (if (assoc 39 dxf_ent) (assoc 39 dxf_ent) '(39 . 0.0))
            (cons 10 (list (car fst_pt) (cadr fst_pt)))
            '(40 . 0.0)
            '(41 . 0.0)
            '(42 . 1.0)
            (cons 10 (list (car opp_pt) (cadr opp_pt)))
            '(40 . 0.0)
            '(41 . 0.0)
            '(42 . 1.0)
            (assoc 210 dxf_ent)
          )
        )
      )
      ; (setvar 'cmdecho 0)
      ; (vl-cmdf "_copybase" (caddr pt_cen) "_L" "" "_pasteclip" (caddr pt_cen)) ;; traps circle if escaped..
      ; (setvar 'cmdecho 1)
      (entdel ent)
  )
)
  ;(prompt "\nMissed or picked wrong entity type or last entity in database not CIRCLE...")
  )
     (*error* nil)
 (princ)
)