Page 2 of 2 FirstFirst 12
Results 11 to 18 of 18

Thread: Convert Survey Figure and Feature Line to 2D Polyline

  1. #11
    Certified AUGI Addict rkmcswain's Avatar
    Join Date
    2004-09
    Location
    Earth
    Posts
    9,621

    Default Re: Convert Survey Figure and Feature Line to 2D Polyline

    I don't suppose you have an update that will process multiple feature lines at once?

    If not, do you mind if I make the edits and post the revised code here?
    R.K. McSwain | CAD Panacea |

  2. #12
    Administrator Opie's Avatar
    Join Date
    2002-01
    Location
    jUSt Here (a lot)
    Posts
    8,405

    Default Re: Convert Survey Figure and Feature Line to 2D Polyline

    Quote Originally Posted by rkmcswain View Post
    I don't suppose you have an update that will process multiple feature lines at once?

    If not, do you mind if I make the edits and post the revised code here?
    I figured someone would ask. I developed the _ConvertFigureToPolyline function to accept a single figure line type object. The ssget found in the figure2poly would need to be modified along with the necessary loop to accept multiple feature lines.

    I will not be posting my edit. You are free to do so here, though.
    If you have a technical question, please find the appropriate forum and ask it there.
    You will get a quicker response from your fellow AUGI members than if you sent it to me via a PM or email.
    jUSt

  3. #13
    Certified AUGI Addict rkmcswain's Avatar
    Join Date
    2004-09
    Location
    Earth
    Posts
    9,621

    Default Re: Convert Survey Figure and Feature Line to 2D Polyline

    Done.... with the disclaimer that this was a quick and dirty edit. It served my purpose this morning.

    Thanks!!


    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... "
      )
      (setq myss (ssget '((0 . "AECC_SVFIGURE,AECC_FEATURE_LINE"))) i 0)
      (repeat (sslength myss)
        (setq oFigure (vlax-ename->vla-object (ssname myss i)))
        (_ConvertFigureToPolyline oFigure)
        (setq i (1+ i))
      )  
        
        
      
    ;;;  (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)
    )
    R.K. McSwain | CAD Panacea |

  4. #14
    Member
    Join Date
    2006-11
    Posts
    5

    Default Re: Convert Survey Figure and Feature Line to 2D Polyline

    Thanks for this. I found a couple of issues, the current layer wasn't reverting back and I wanted linetype generation turned on for proper patterning.

    I moved the main subroutine inside and moved lstVariables and cleaned up a little (deleted unused code and variables)

    Code:
    (defun c:figure2poly ( / _ConvertFigureToPolyline _Space _SetSysVar *Error* _safelist _variantvalue ss oFigure lstVariables )
    
      (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
      (setq lstVariables nil)
      
      ;; defun subroutines
      
      ;; main routine
      (defun _ConvertFigureToPolyline ( oFigure / arr2DPoints arrSpace fr i lst2dPoints lstBulge objPolyline ss x y z )
    
        (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))))
          (setq lstBulge (append lstBulge (list (vlax-invoke-method oFigure 'GetBulgeAtPoint (vlax-3d-point (list (nth x fr) (nth y fr) (nth z fr)))))))
          (setq 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))
        (setq objPolyline (vlax-invoke-method (_Space) 'AddLightWeightPolyline arr2DPoints))
        (foreach n lstBulge
          (vla-setbulge objPolyline (setq i (1+ i)) n)
        )
        (vlax-put-property objPolyline 'LinetypeGeneration :vlax-true)
      )
    
      ;; 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
    
      ;; error routine - restores system variables
      (defun *error* ( strMessage / )
        (if (or (= strMessage "Function cancelled") ; If user cancelled
                (= strMessage "quit / exit abort")  ; If user aborted
                (null strMessage))                  ; End quietly
          (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))
    
      ;_ 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 feature lines or survey figures to polylines... ")
      (setq myss (ssget '((0 . "AECC_SVFIGURE,AECC_FEATURE_LINE"))) i 0)
      (repeat (sslength myss)
        (setq oFigure (vlax-ename->vla-object (ssname myss i)))
        (_ConvertFigureToPolyline oFigure)
        (setq i (1+ i)))
      (*error* nil)
      (princ))
    
    (princ)
    Attached Files Attached Files
    Last edited by GTVic; 2017-06-08 at 01:20 AM.

  5. #15
    Member
    Join Date
    2004-08
    Location
    Tennessee
    Posts
    8

    Default Re: Convert Survey Figure and Feature Line to 2D Polyline

    Can you edit the multiple selection figure2poly routine to move the featureline to the breakline layer like the single object figure2poly routine does?

    Thanks ahead of time,
    Mike McCulley, RLS

  6. #16
    Woo! Hoo! my 1st post
    Join Date
    2017-12
    Posts
    1

    Default Re: Convert Survey Figure and Feature Line to 2D Polyline

    I have successfully made the figure@poly command. I need help making the command convert multiple feature lines at the same time.

  7. #17
    Administrator Opie's Avatar
    Join Date
    2002-01
    Location
    jUSt Here (a lot)
    Posts
    8,405

    Default Re: Convert Survey Figure and Feature Line to 2D Polyline

    Quote Originally Posted by CStark86 View Post
    I have successfully made the figure@poly command. I need help making the command convert multiple feature lines at the same time.
    Please see one of the two responses to my code making it work on multiple feature lines.
    If you have a technical question, please find the appropriate forum and ask it there.
    You will get a quicker response from your fellow AUGI members than if you sent it to me via a PM or email.
    jUSt

  8. #18
    Woo! Hoo! my 1st post
    Join Date
    2019-03
    Posts
    1

    Default Re: Convert Survey Figure and Feature Line to 2D Polyline

    First off, great lisp, and then one question, what would be modified if I wanted to simply delete the figure / feature line once the polyline has been created?

Page 2 of 2 FirstFirst 12

Similar Threads

  1. Double Click a Line to Convert it to a Polyline
    By zoomharis in forum AutoCAD Tips & Tricks
    Replies: 23
    Last Post: 2016-05-29, 09:21 PM
  2. Line Work (Survey Figure) Issue
    By dwknutson in forum AutoCAD Civil 3D - General
    Replies: 1
    Last Post: 2012-11-29, 02:46 PM
  3. Create an Alignment from a Survey Figure Line
    By Wish List System in forum Civil 3D Wish List
    Replies: 0
    Last Post: 2012-11-13, 03:02 PM
  4. Convert feature line to alignment/profile
    By IanR in forum Civil 3D Wish List
    Replies: 0
    Last Post: 2010-10-06, 02:10 AM
  5. Convert an ARC to a Line or Polyline
    By nigel.chesworth in forum AutoCAD General
    Replies: 4
    Last Post: 2006-01-13, 10:02 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •