Initial commit

downloaded/ArcToLine.lsp

@@ -0,0 +1,106 @@
+(defun c:ArcToLine  (/ *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 blg (cons (list
+   (vla-getbulge ent (setq num (1- 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 ncrement length: "))
+    )
+     (progn
+       (setq objts (vlax-ename->vla-object ent))
+       (setq 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 stp (if (zerop
+        (setq cur (vlax-curve-getDistAtPoint
+      objts
+      (trans (cadr itm) 1 0)
+           )
+        )
+      )
+    (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)
+        )
+      )
+    )
+  )
+       )
+       clr
+       (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)
+)