106 lines
2.4 KiB
Common Lisp
106 lines
2.4 KiB
Common Lisp
(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)
|
|
) |