I've recently needed this feature, so I came up with this. It seems to work for most things I have tested it on.
Code:
(defun _ConvertFigureToPolyline (oFigure /
arr2DPoints arrSpace fr
i lst2dPoints lstBulge
lstVariables objPolyline ss
x y z
)
;;====================
;; Begin Main Routine
;;====================
(setq i -1
x 0
fr (_safelist (vlax-invoke-method oFigure 'GetPoints 1))
)
(repeat (/ (length fr) 3)
(setq y (1+ x)
z (1+ y)
lst2DPoints
(append lst2DPoints (list (nth x fr) (nth y fr)))
lstBulge
(append lstBulge
(list
(vlax-invoke-method
oFigure
'GetBulgeAtPoint
(vlax-3d-point
(list (nth x fr) (nth y fr) (nth z fr))
)
)
)
)
x (+ x 3)
)
)
(setq arrSpace
(vlax-make-safearray
vlax-vbdouble
(cons 0 (- (length lst2DPoints) 1))
)
)
(setq arr2DPoints (vlax-safearray-fill arrSpace lst2DPoints))
(vlax-make-variant arr2DPoints)
(_SetSysVar "clayer" (vla-get-layer oFigure))
(if (not (tblsearch "LAYER" strBreaklineLayer))
(_AddLayer strBreaklineLayer)
)
(vla-put-layer oFigure strBreaklineLayer)
(setq objPolyline
(vlax-invoke-method
(_Space)
'AddLightWeightPolyline
arr2DPoints
)
)
(foreach n lstBulge
(vla-setbulge objPolyline (setq i (1+ i)) n)
)
)
(defun c:figure2poly (/ _AddLayer _Space
_SetSysVar *Error* strBreakline
_safelist _variantvalue
ss oFigure
)
(vla-startundomark
(vla-get-activedocument (vlax-get-acad-object))
)
;;===================================
;; Initiliaze user defined variables
;;===================================
(setq strBreaklineLayer "breakline")
;;===================
;; Defun subroutines
;;===================
;;_ Returns the active space object
(defun _Space (/ *DOC* space)
(setq *DOC* (vla-get-activedocument (vlax-get-acad-object)))
(setq space (if (= 1 (vla-get-activespace *DOC*))
(vla-get-modelspace *DOC*) ;_ Model Space
(if (= (vla-get-mspace *DOC*) :vlax-true)
(vla-get-modelspace *DOC*) ;_ Model Space through Viewport
(vla-get-paperspace *DOC*) ;_ Paper Space
)
)
)
)
(defun *error* (strMessage /)
(if (or
(= strMessage "Function cancelled") ; If user cancelled
(= strMessage "quit / exit abort") ; If user aborted
(null strMessage) ; End quietly
) ; End or sequence
(princ) ; Exit quietly
(princ (strcat "\nError: " strMessage)) ; Report Error
)
(if lstVariables
(mapcar '(lambda (x) (setvar (car x) (cdr x))) lstVariables)
)
(vla-endundomark
(vla-get-activedocument (vlax-get-acad-object))
)
(princ)
)
;;_ Adjust system variable and save original to list
(defun _SetSysVar (name value /)
(if lstVariables
(if (null (assoc name lstVariables))
(setq lstVariables
(append lstVariables
(list (cons name (getvar name)))
)
)
)
(setq lstVariables (list (cons name (getvar name))))
)
(setvar name value)
)
;_ Add a new layer to the layers collection
;_ Syntax (AddLayer "layername")
;_ Function returns T if successful nil if not
(defun _AddLayer (strLayerName / objLayer)
(if (and (= (type strLayerName) 'STR)
(not (tblsearch "LAYER" strLayerName))
)
(progn
(setq
objLayer (vla-add
(vla-get-layers
(vla-get-activedocument (vlax-get-acad-object))
)
strLayerName
)
)
(vlax-release-object objLayer)
t
)
)
)
;_ Convert Safearray to list
(defun _safelist (value)
(if (= (type value) 'VARIANT)
(setq value (_variantvalue value))
)
(setq value (vl-catch-all-apply 'vlax-safearray->list (list value)))
(if (vl-catch-all-error-p value)
nil
value
)
)
;_ Get value of variant
(defun _variantvalue (value)
(setq value (vl-catch-all-apply 'vlax-variant-value (list value)))
(if (vl-catch-all-error-p value)
nil
value
)
)
(princ
"\rConvert a feature line or survey figure to polyline... "
)
(if (setq ss (ssget ":S:E" '((0 . "AECC_SVFIGURE,AECC_FEATURE_LINE"))))
(progn
(setq oFigure
(vlax-ename->vla-object (ssname ss 0))
)
(_ConvertFigureToPolyline oFigure)
)
)
(*error* nil)
)
To use it, of course, you will need to copy and paste it to a file with a .lsp file extension and then load that file into the drawing. There are numerous ways to load autolisp files with many posted throughout these forums.
Once it is loaded, you would execute the command with figure2poly. Then select the feature line or survey figure you wish to convert. The routine will generate a new 2d polyline on the layer which the selected object resides. It will then change the layer of the selected object to a "breakline" layer. This portion of the routine could be changed, but I'll leave it to others to work out.
I believe I have all necessary sub-routines included in the code above. If it is telling you a routine is not available, please let me know so I can provide it.
HTH,
Opie
Convert Survey Figure and Feature Line to 2D Polyline
Reply With Quote
