Page 1 of 4 1234 LastLast
Results 1 to 10 of 38

Thread: Get Polyline segments

  1. #1
    Member
    Join Date
    2011-08
    Posts
    30
    Login to Give a bone
    0

    Default Get Polyline segments

    Hi!

    Can you help me with this routine. It contains all polylinepoints in a exceltabell and insert koordinatpunkt-block on polylinepoints.
    It would be nice to become the polylinesegments with line- or arc-length.
    I don´t know how can I do this.

    Code:
    (setq num (getint "\nSelect start number: ")); continue point number
    (setq num (- num 1))
    (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (setq i1 0)
    (setq csvf (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".csv"))
    (setq z (open csvf "w"))
    (write-line
      (strcat ";" "Nr" ";" "Definition" ";" "X-koord" ";" "Y-koord") z)
    (repeat (sslength ss)
      (setq ename (ssname ss i1))
      (setq edata (entget ename))
      (cond
        ((= (cdr (assoc 0 edata)) "LWPOLYLINE")
        (foreach n1 edata
          (cond
        ((= (car n1) 10)
         (setq Punktliste (cons (cdr n1) Punktliste))
         (setq num (1+ num))
         (command "insert" "koordinatpunkt" (car Punktliste) 1 1 0 (itoa NUM))
         )
        )
          )
         )
        )
      (progn
        (write-line
          (apply 'strcat (mapcar '(lambda(X) (strcat (apply 'strcat (mapcar '(lambda(Y) (strcat ";" (vl-princ-to-string Y)))X))"\n")
                    )
                     Punktliste
                     )
             )
          z)
        )
      (setq i1 (1+ i1))
      )
    (close z)
    (getstring "\nPress Enter: ")
    (startapp "C:\\Program Files (x86)\\Microsoft Office\\Office12\\EXCEL.EXE" (strcat "\"" csvf "\""))
    Last edited by Opie; 2012-01-17 at 03:07 PM. Reason: [code] tags added

  2. #2
    Certifiable AUGI Addict
    Join Date
    2001-03
    Location
    Tallahassee, FL USA
    Posts
    3,679
    Login to Give a bone
    0

    Default Re: Get Polyline segments

    I've got an old routine that labels both line or arc lwpolyline segments. It copies the lwpolyline, explodes it, gets the info of the selected segment, deletes the exploded segments, and labels the segment using a block with attributes.

    Check out: http://forums.augi.com/showthread.php?t=133869

  3. #3
    Member
    Join Date
    2011-08
    Posts
    30
    Login to Give a bone
    0

    Default Re: Get Polyline segments

    Thanks
    It´s much stuff to understand. In the beginning i like it little easier.
    But it´s a very good idear to copy, explode, read entitys and delete it

  4. #4
    AUGI Addict fixo's Avatar
    Join Date
    2005-05
    Location
    Pietari, Venäjä
    Posts
    1,269
    Login to Give a bone
    0

    Default Re: Get Polyline segments

    Buggy code removed
    Wat for changes, please
    Sorry


    ~'J'~
    Last edited by fixo; 2011-12-17 at 06:18 AM. Reason: wrong code

  5. #5
    Member
    Join Date
    2011-08
    Posts
    30
    Login to Give a bone
    0

    Default Re: Get Polyline segments

    Thanks for your effort. I can learn about and have to do something...

  6. #6
    AUGI Addict fixo's Avatar
    Join Date
    2005-05
    Location
    Pietari, Venäjä
    Posts
    1,269
    Login to Give a bone
    0

    Default Re: Get Polyline segments

    You're welcome
    Cheers

    ~'J'~

  7. #7
    Member
    Join Date
    2011-08
    Posts
    30
    Login to Give a bone
    0

    Default Re: Get Polyline segments

    @fixo
    I´ve a question: If I have en polyline med arc-elements inserts function correctly var. coors, but it works not correctly in lin
    (setq pline_data (trace-pline pln bulge_list))

    var pline_data is nil
    Have you a answer why function trace-pline not works

    I know this function transfer coordinates to excel or?

  8. #8
    AUGI Addict fixo's Avatar
    Join Date
    2005-05
    Location
    Pietari, Venäjä
    Posts
    1,269
    Login to Give a bone
    0

    Default Re: Get Polyline segments

    Upload this polyline in simple drawing
    and drop it to attachments to see where
    I was mistaken
    (I use 2009)

    ~'J'~

  9. #9
    Member
    Join Date
    2011-08
    Posts
    30
    Login to Give a bone
    0

    Default Re: Get Polyline segments

    I can´t uppload dwg-file here. Can you send me your email-adress
    cadplayer@gmail.com

    PS: Have you test it with an normal Polyline with arc-and-line-segemts
    Last edited by diroscan198177; 2011-12-16 at 02:14 PM.

  10. #10
    AUGI Addict fixo's Avatar
    Join Date
    2005-05
    Location
    Pietari, Venäjä
    Posts
    1,269
    Login to Give a bone
    0

    Default Re: Get Polyline segments

    Quote Originally Posted by diroscan198177 View Post
    I can´t uppload dwg-file here. Can you send me your email-adress
    cadplayer@gmail.com

    PS: Have you test it with an normal Polyline with arc-and-line-segemts
    Ok, try again
    Tested just very limited
    Code:
     
    ;load ActieX library
    (vl-load-com)
    ;; Local defuns
    (defun startnumber () ; asks user for counter
    ;;save all globals
    (if (not *init*)(setq *init* 1))
    ;; save *init* as *initsave*
    (setq *initsave* *init*)
    ;; prompt for number
    (princ "\nEnter a starting number: <")
    (princ *init*)
    (setq *init* (getint ">: "))
    ; if user accepted default 
    (if(not *init*)(setq *init* *initsave*))
    ;; return
    *init*
    )
     
    ;; group list by number of items in the sublist
     
    (defun group-by-num (lst num / ls ret)
      (if (= (rem (length lst) num ) 0)
        (progn
          (setq ls nil)
          (repeat (/ (length lst) num)
     (repeat num (setq ls 
          (cons (car lst) ls)
           lst (cdr lst)))
     (setq ret (append ret (list (reverse ls)))
           ls nil)))
        )
    ret
      )
     
    ;; get polyline vertices
     
    (defun get-vexs (pline_obj / verts)
          (setq verts (vlax-get pline_obj 'Coordinates)
         verts
        (cond
          ((wcmatch (vlax-get pline_obj 'Objectname )
            "AcDb2dPolyline,AcDb3dPolyline") 
           (group-by-num verts 3)
          )
          ((eq (vlax-get pline_obj 'Objectname )
            "AcDbPolyline") 
           (group-by-num verts 2)
          )
          (T nil)
        )
    )
      )
    ;; get bulge radius
    ;; math by Juergen Menzi
    (defun get-radii  (p1 p2 bulge)
      (abs (/ (distance p1 p2) 2 (sin (/ (* 4 (atan (abs bulge))) 2)))))
    ;;get segment arc center
    ;;math by John Uhden
    (defun get-segm-center  (pline p1 p2 bulge / cpt midc midp rad)
    (setq rad (get-radii p1 p2 bulge)
          midp (vlax-curve-getpointatparam pline
           (+ (fix (vlax-curve-getparamatpoint pline p1)) 0.5))
          midc (mapcar (function (lambda (x y)(/ (+ x y) 2))) p1 p2)
          cpt (trans (polar midp (angle midp midc) rad) 0 1)
    )
    cpt
    )
     
    ;;*** list to csv readable string ***777777777777777777777777777
    (defun list->csv(lst sep / join)
    ;;arguments
    ;; lst -list of string like: '("CENTER" "-4612.43" "5043.47" "1787.77")
    ;;sep - string (separator, i.e: ",")
    ;;return string like "CENTER,-4612.43,5043.47,1787.77"
      (setq join (apply 'strcat (mapcar  '(lambda (x)(strcat x  sep)) lst))
                  join (vl-string-right-trim sep join))
      join
      )
    ;;   ===============================   main part   =============================;;
    (defun C:KOORPTS (/  *error* atd atq blg center cnt coords csvf csv_data datafile dirty
                          ent first firstbulge firstp i itm lastbulge lastp num pln pos prec rad)
     
      (defun *error* (msg)
      (if (and msg (not (wcmatch msg "Function cancelled,quit / exit abort,console break")))
        (princ (strcat "\nError: " msg))
      )
      (command)
      (command "_.undo" "_end")
      (setvar 'attdia 1)
      (if atq (setvar 'attreq atq))
    )
      ;; change block name below
      (if (not (tblsearch "block" "koordinatpunkt"))
        (progn
        (alert "Block \"koordinatpunkt\" does not exist")
        (exit)(princ))
        )
     
    (command "_.undo" "_begin")
     (setq atq (getvar 'attreq))
    (setq atd (getvar 'attdia))
     
    (startnumber)
     
    (setq num *init*); continue point number returned from global
     
    (setq cnt num);<-- store for future use
     
    ;; select single entity
      (setq ent (entsel "\n\t>>>\tSelect polyline\t<<<\n"))
      (if (not ent)
        (while (or (not ent)(not (eq (strcase (cdr (assoc 0 (entget (car ent))))T )"lwpolyline")))
          (princ "\nNothing or wrong object type selected, try again... ")
          (setq ent (entsel  "\n\t>>>\tYou have to pick single LWPOLYLINE only\t<<<\n")))
        )
      ;; if Esc pressed
       (if (not ent)
         (progn
           (exit)
           (princ))
        )
    ;; if selected, convert it to VLA-object
    (setq pln (vlax-ename->vla-object (car ent)))
     
     ;; get coordinates
    (setq coords (get-vexs pln))
     
      (setq closed (if (eq :vlax-true (vla-get-closed pln))
                     t
                     nil)
            )
    ;;insert labels
    (setvar 'attreq 1)
    (setvar 'attdia 0)
      ;; change block name below
    (foreach pt coords
    (command "insert" "koordinatpunkt" (trans pt 1 0) "1"  "0" (itoa num))
    (setq num (1+ num))
     
      )
    (setq prec 3) ;<-- set number of decimals (precision) for csv here
    (setq dirty nil);debug only
    (setq i 0)
    (foreach p coords
      (setq blg (vla-getbulge pln i))
      (setq dirty (cons (if (not closed)
                                 (if (and (< i (1- (length coords))) (> (abs (setq blg (vla-getbulge pln i))) 0))
                          (cons p blg)
                          p
                        )
                              (if (> (abs (setq blg (vla-getbulge pln i))) 0)
                          (cons p blg)
                          p
                        ))  
                        dirty
                  )
      )
      (setq i (1+ i))
    )
     
    (setq *init* (+ *init* i));<-- store last number to global for the next polyline, if that's needs
    (setq dirty (reverse dirty))
    (setq dirty (apply 'append
                       (mapcar (function (lambda (x)
                                           (if (listp (cdr x))
                                             (list x)
                                             (append (list (car x)) (list (list nil (cdr x))))
                                           )
                                         )
                               )
                               dirty
                       )
                )
    )
    (setq *first* dirty);debug only
    ;; to add some formatting for inforamtive csv data
    (cond
      ;; If opened polyline
      ((not closed)
       (if (not (car (car dirty)))
         (progn
            (setq firstbulge T)
         (setq dirty (append (append (list (cadr dirty))(list (cadr dirty))) (cddr dirty)))
         ))
       (if (not (car (last dirty)))
         (progn
            (setq lastbulge T)
        (setq dirty (append (append  (reverse (cddr (reverse dirty)))(list (last dirty)))(list (nth (- (length dirty) 2) dirty))))
         ))
     
       )
       ;; If closed polyline
     (T
      (cond
       ;; If the first closed segment has bulge
      ((not (car (car dirty)))
           (setq dirty (append  (list (last  dirty))dirty)) 
           (setq firstbulge T)
    ;;;       (setq lastbulge nil)
       )
     
      ;;  If the last closed segment has bulge
          ((not (car (nth(- (length dirty) 1) dirty)))
           (setq dirty (append dirty (list (car dirty)))) 
           (setq lastbulge T)
    ;;;       (setq firstbulge nil)
           )
      )
      )
      (T nil)
       )
    (setq *second* dirty);debug only
      ;;calculate radius and center of an arc, then rebuild the data list
      (setq dirty (mapcar (function
                            (lambda (x)
                              (if (not (car x))
                                (progn (setq pos (vl-position x dirty))
                                       (setq center (get-segm-center pln (nth (1- pos) dirty) (nth (1+ pos) dirty) (last x)))
                                       (setq rad (get-radii (nth (1- pos) dirty) (nth (1+ pos) dirty) (last x)))
                                       (setq x (subst (list (car center) (cadr center)) nil x))
                                       (subst rad (last x) x)
                                )
                                x
                              )
                            )
                          )
                          dirty
                  )
      )
    ;; build csv data
    (setq i (1- cnt))
    (setq csv_data nil)
    (foreach tmp dirty
      (if (numberp (car tmp))
        (progn (setq itm (append (list (itoa (1+ i))) (list (rtos (car tmp) 2 prec) (rtos (cadr tmp)))))
               (setq i (1+ i))
        )
        (setq itm (append (list "CENTER")
                          (list (rtos (caar tmp) 2 prec) (rtos (cadar tmp) 2 prec) (rtos (last tmp) 2 prec))
                  )
        )
      )
      (setq csv_data (cons itm csv_data))
    ) 
       (setq csv_data (reverse csv_data))
     
    ;; swap vertices numbers of bulged segment as it will be written in csv
     
      (if closed
        (progn
    (if firstbulge
       (progn (setq first (car (last csv_data)))
         (setq firstp  (subst first (caar csv_data)(car csv_data)))
         (setq  csv_data (subst firstp (car csv_data)csv_data))))
     
     (if lastbulge
       (progn (setq first (caar csv_data))
         (setq lastp  (subst first (car (last csv_data))(last csv_data)))
         (setq  csv_data (subst lastp (last csv_data)csv_data))))
      )
        )
     
      ;; write data list info to excel csv
     
       (setq csvf (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".csv"));<-- may be change on .xls?
      (setq datafile (open csvf "W"))
      (write-line "No;X;Y;Radius"  datafile);<-- change headers here
     
     (foreach p csv_data
     
      (write-line (list->csv p ";")  datafile)
     
      )
     
           (close datafile)
      (getstring "\nPress Enter: ")
    (startapp "C:\\Program Files\\Microsoft Office\\Office12\\EXCEL.EXE" (strcat "\"" csvf "\"")) ;<-- path here
    (*error* nil)
      (princ)
      )
    (prompt "\n\t   >>> Start command with KOORPTS   <<<")
    (prin1)
    ;;;(C:KOORPTS);debug from console

Page 1 of 4 1234 LastLast

Similar Threads

  1. 2015: Separate colours for different segments within one polyline
    By j.lathouwers in forum AutoCAD General
    Replies: 4
    Last Post: 2015-04-13, 12:34 PM
  2. Different colours for separate polyline segments
    By Wish List System in forum AutoCAD Wish List
    Replies: 2
    Last Post: 2015-04-13, 12:04 PM
  3. Replies: 3
    Last Post: 2013-04-02, 04:11 PM
  4. Converting line segments into polyline
    By VBOYAJI in forum AutoCAD Map 3D - General
    Replies: 9
    Last Post: 2007-06-25, 01:56 PM
  5. Changing polyline curves to straight segments
    By gadjet in forum AutoCAD General
    Replies: 3
    Last Post: 2007-01-29, 05:53 PM

Tags for this Thread

Posting Permissions

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