arc_to_line.lsp

arc_to_line.lsp

(defun c:ArcToLine2 (/ *error* blg blk ent objts cnt blgLoc pts stp mxp cur ent2d)
  (vl-load-com)

  (defun *error* (msg)
    (and uFlag (vla-EndUndoMark doc))
    (and ov (mapcar (function setvar) vl ov))
    (and msg
         (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
             (princ (strcat "\n** Error: " msg " **"))))
    (princ))

  (defun blg (ent num / blg)
    (repeat num
      (setq num (1- num))
      (setq blg (cons
                  (list
                    (vla-getbulge ent num)
                    (trans (vlax-safearray->list (variant-value (vla-Get-coordinate ent num))) 0 1))
                  blg))))

  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
        vl  '("CMDECHO" "OSMODE" "ORTHOMODE")
        ov  (mapcar (function getvar) vl))

  (prompt "\nSelect LWPOLYLINE To convert:")

  (if (and (setq uFlag (not (vla-StartUndoMark doc)))
           (mapcar (function setvar) vl '(0 0 0))
           (setq pts nil
                 ent (car (entsel "\nSelect Polyline Boundary:\n")))
           (eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
           (setq alen (getdist "\nEnter line increment length: ")))
    (progn
      (setq objts   (vlax-ename->vla-object ent)
            cnt     0
            blgLoc (blg objts (cdr (assoc 90 (entget ent)))))

      (foreach itm blgLoc
        (setq cnt (1+ cnt))
        (if (= (car itm) 0.0)
          (setq pts (cons (trans (cadr itm) 1 0) pts))
          (progn
            (setq pts (cons (trans (cadr itm) 1 0) pts))
            (setq cur (vlax-curve-getDistAtPoint objts (trans (cadr itm) 1 0))
                  stp (if (zerop cur) (vla-get-length objts) cur)
                  nxp (if (>= (1+ cnt) (cdr (assoc 90 (entget ent))))
                        (vla-get-length objts)
                        (vlax-curve-getDistAtPoint objts (trans (cadr (nth cnt blgLoc)) 1 0))))
            (while (< (setq stp (+ stp alen)) nxp)
              (setq pts (cons (vlax-curve-getPointAtDist objts stp) pts))))))

      (if pts
        (progn
          (setq ent2d
                 (entmakex
                   (append
                     (list
                       (cons 0 "LWPOLYLINE")
                       (cons 100 "AcDbEntity")
                       (cons 100 "AcDbPolyline")
                       (cons 90 (length pts))
                       (cons 70 0))
                     (mapcar (function (lambda (p) (cons 10 p))) pts))))
          (entdel ent)))

      (setq uFlag (vla-EndUndoMark doc))))

  (*error* nil)
  (princ))