Author Topic: Polyline Circle multi and escapable  (Read 845 times)

0 Members and 1 Guest are viewing this topic.

ScottMC

  • Newt
  • Posts: 192
Polyline Circle multi and escapable
« on: July 25, 2022, 08:22:47 PM »
Really want some insight into understanding what this lisp does.. as it really makes this repeatability work.
Mr. ribarm is the source and really encourages me to learn!
 
Code: [Select]
(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 (< 0 (getvar 'cmdactive)) (command nil)) ;; < turned commans-s to command! [A2K]
    (setvar 'menuecho 1)
    ;;----- Display error message if applicable
    (cond
      ((not msg))
      ((member
         (strcase msg t)
         '("console break" "function cancelled" "quit / exit abort")
       )
       (princ "\nFunction Cancelled.")
      )
      ((princ (strcat "\nApplication Error: "
                      (itoa (getvar 'errno))
                      " :- "
                      msg
              )
       )
       ;;----- Display backtrace
       ;(vl-bt)
      )
    )
    (setvar 'errno 0)
  ) ;; end of error..

(while
(vl-cmdf "circle" "\\")
(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)
)
« Last Edit: July 25, 2022, 09:08:44 PM by ScottMC »