+ Reply to Thread
Results 1 to 4 of 4
  1. #1
    Forum Newbie
    Using
    AutoCAD 2016
    Join Date
    Sep 2013
    Posts
    9

    Default polyline kilometer along

    Registered forum members do not see this ad.

    Hello to all,

    I have a challenge to place text markers along a polyline. As this polyline represents the trace of an linear object (in my case cable line) I would like to have at every 250m the length from the start of the line represented as "X +YYY", where X is the kilometer and YYY are the meters. Also it would be good to have the length from the start at every vertex.
    Can anyone help me with this, as I have no knowledge from lisp programing.

    Regards and thanks in advance!
    Last edited by sadefa; 5th Jun 2016 at 01:07 pm.

  2. #2
    Luminous Being Tharwat's Avatar
    Discipline
    Mechanical
    Tharwat's Discipline Details
    Occupation
    MEP AutoCAD Draughtsman
    Discipline
    Mechanical
    Details
    HVAC, Drainage, Water Supply, Fire Fighting and a little about Electricity.
    Using
    AutoCAD 2015
    Join Date
    Oct 2009
    Location
    Great Syria , Living in Abu Dhabi
    Posts
    6,050

    Default

    Can you show an example with a sample drawing and what are the requested info should be given from a user ?

  3. #3
    Forum Newbie
    Using
    AutoCAD 2016
    Join Date
    Sep 2013
    Posts
    9

    Default

    Sorry, I do not have CAD software at the place where I am at right now, but I have an image that shows exactly what I am looking for.pline km.jpg
    Last edited by sadefa; 5th Jun 2016 at 05:40 pm.

  4. #4
    Luminous Being
    Using
    Civil 3D 2016
    Join Date
    Dec 2005
    Location
    GEELONG AUSTRALIA
    Posts
    9,725

    Default

    Registered forum members do not see this ad.

    Sadefa & Tharwat so many versions are already here just search for "chainage" most can be simply changed to reflect the 3+500

    Here is one not sure where it came from but it does mention use of +
    Code:
    ; chainage lables of pline
    ;but you can change "+" if you want to anything else, and if you don't want it just change it to "" - empty string
    
    (defun div-error (msg)
      (if
        (vl-position
          msg
          '("console break"
            "Function cancelled"
            "quit / exit abort"
           )
        )
         (princ "Error!")
         (princ msg)
      )
      (while (> (getvar "cmdactive") 0) (command))
    
      (setq *error* olderror)
      (princ)
    )
    
    (defun divplus (len segm / num lst)
      (setq num (fix (/ len segm)))
      (setq cnt 0)
      (while (<= cnt num)
        (setq tmp (* cnt segm))
        (setq lst (append lst (list tmp)))
        (setq cnt (1+ cnt))
      )
      (setq delta (- len (last lst)))
      (if (not (zerop delta))
        (setq lst (append lst (list (+ (last lst) delta))))
        lst
      )
    )
    
    (defun divminus (len segm / lst)
      (while (>= len 0.)
        (setq lst (append lst (list len)))
        (setq len (- len segm))
      )
      (if (not (zerop (last lst)))
        (setq lst (append lst (list 0.0)))
      )
      lst
    )
    
    (defun alg-ang (obj pnt)
      (angle '(0. 0. 0.)
             (vlax-curve-getfirstderiv
               obj
               (vlax-curve-getparamatpoint
                 obj
                 pnt
               )
             )
      )
    )
    
    (defun answer (quest / wshl ans)
      (or (vl-load-com))
      (setq wshl (vlax-get-or-create-object "WScript.Shell"))
      (setq ans (vlax-invoke-method
                  wshl             'Popup           quest
                  7                "Answer This Question:"
                  vlax-vbYesNo
                 )
      )
      (vlax-release-object wshl)
      (cond ((= ans 6)
             (setq opt T)
            )
            ((= ans 7)
             (setq opt nil)
            )
      )
      opt
    )
    
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
    (defun make-station (bname    /        acsp     adoc     atprom
                         attag    at_obj   blk_obj  hgt      lay
                         line_obj sfar
                        )
    
      (vl-load-com)
      (setq adoc (vla-get-activedocument
                   (vlax-get-acad-object)
                 )
      )
      (if (and
            (= (getvar "tilemode") 0)
            (= (getvar "cvport") 1)
          )
        (setq acsp (vla-get-paperspace adoc))
        (setq acsp (vla-get-modelspace adoc))
      )
      (vla-startundomark adoc)
    
      (if (not (tblsearch "block" bname))
        (progn
          (setq attag  "NUMBER"             ;(strcase (getstring "\nAttribute tag : \n"))
                atprom "NUMBER"             ;(strcase (getstring T "\nAttribute prompt : \n"))
                hgt    1.0                  ;(getreal "\nAttribute text height : \n")
          )
    
          (setq lay (getvar "clayer"))
          (setvar "clayer" "0")
          (setvar "attreq" 0)
    
          (setq line_obj (vlax-invoke
                           acsp
                           'Addline
                           '(0. -3. 0.)
                           (list 0. (* hgt 2.) 0.)
                         )
          )
          (vla-put-color line_obj acred)
          (setq blk_obj (vla-add (vla-get-blocks adoc)
                                 (vlax-3d-point '(0. 0. 0.))
                                 bname
                        )
                sfar    (vlax-safearray-fill
                          (vlax-make-safearray vlax-vbObject '(0 . 0))
                          (list line_obj)
                        )
          )
          (vla-copyobjects adoc sfar blk_obj)
    ;;;  RetVal = object.AddAttribute(Height, Mode, Prompt, InsertionPoint, Tag, Value) 
          (setq at_obj (vla-addattribute
                         blk_obj
                         hgt
                         acattributemodeverify
                         atprom
                         (vlax-3d-point '(0 10. 0.))
                         attag
                         "0"
                       )
          )
    
          (vla-put-rotation at_obj (* pi 1.5))
          (vlax-release-object blk_obj)
        )
        (progn
          (princ "\n\t >> Block does already exist!\n")
          (princ)
        )
      )
      (if (tblsearch "block" bname)
        T
        (progn
          (alert "Impossible to add block")
        )
      )
      (setvar "attreq" 1)
      (setvar "clayer" lay)
      (vl-catch-all-apply
        (function (lambda () (vla-delete line_obj)))
      )
      (vla-regen adoc acactiveviewport)
      (vla-endundomark adoc)
      (vlax-release-object acsp)
      (vlax-release-object adoc)
      (princ)
    )
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
    (or (vl-load-com))
    (defun C:d10 (/        *error*  acsp     adoc     appd     div-error
                  len      num      olderror pl       pt       pt_list
                  step     util
                 )
    
      (or adoc
          (setq adoc
                 (vla-get-activedocument
                   (vlax-get-acad-object)
                 )
          )
      )
      (or appd (setq appd (vla-get-application adoc)))
      (or acsp
          (setq acsp
                 (vla-get-block
                   (vla-get-activelayout adoc)
                 )
          )
      )
      (or util (setq util (vla-get-utility adoc)))
    
      (setq olderror *error*)
      (setq *error* div-error)
    
      (if (not (tblsearch "block" "Station"))
        (make-station "Station")
      )
    
    
      (vla-getentity
        util
        'pl
        'pt
        "\nSelect line NEAR OF POINT TO START measure: >>> \n"
      )
      (if pl
        (progn
          (setq step 100)
          (setq opt (answer "Rotate text perpendicularly to pline?"))
          (if (not step)
            (setq step 10.)
          )
    
          (setq len (vlax-curve-getdistatparam
                      pl
                      (vlax-curve-getendparam pl)
                    )
          )
    
          (if (< (distance (vlax-safearray->list pt)
                           (vlax-curve-getstartpoint pl)
                 )
                 (distance (vlax-safearray->list pt)
                           (vlax-curve-getendpoint pl)
                 )
              )
            (setq pt_list (divplus len step))
            (setq pt_list (divminus len step))
          )
    
          (setq
            pt_list (vl-remove-if
                      (function not)
                      (mapcar (function (lambda (x)
                                          (vlax-curve-getpointatdist pl x)
                                        )
                              )
                              pt_list
                      )
                    )
          )
    
          (setq num 0)
          (mapcar
            (function
              (lambda (x / dr ang att_list at blk_obj)
                (progn
    
                  (setq ang (alg-ang pl x)
                        ang
                            (cond ((< (/ pi 2) ang (* pi 1.5)) (+ pi ang))
                                  (T ang)
                            )
                  )
                  (setq blk_obj (vlax-invoke
                                  acsp     'Insertblock      x
                                  "Station"         5        5
                                  5        ang
                                 )
                  )
                  (setq att_list (vlax-invoke blk_obj 'Getattributes))
                  (foreach at att_list
                    (if (eq (vlax-get at 'Tagstring) "NUMBER")
                      (progn
                        (vlax-put
                          at
                          'Textstring
                          (if (<= num 900.)
                            (strcat "Ch 0+" (if (equal num 0 1e-15) "000" (rtos num 2 0)) "m")
                            (strcat
                              "Ch "
                              (itoa (fix (/ num 1000.))) "+"
                              (if (equal (- num (* (fix (/ num 1000.)) 1000)) 0 1e-15) "000" (rtos (- num (* (fix (/ num 1000.)) 1000)) 2 0))
                              "m"
                            )
                          )
                        )
                        (if (not opt)
                          (vlax-put at 'Rotation 0)
                        )
                        (vla-update at)
                      )
                    )
                  )
                  (vla-update blk_obj)
                  (vlax-release-object blk_obj)
                  (setq num (+ num step))
                )
              )
            )
            pt_list
          )
    
          (if (not (vlax-object-released-p pl))
            (vlax-release-object pl)
          )
        )
        (princ "\nNothing selected try again\n")
      )
      (vla-zoomextents appd)
      (vla-regen adoc acactiveviewport)
      (setq *error* olderror
            div-error nil
      )
    
      (princ)
    )
    (prompt "\n")
    (prompt "\n    ***    Type D10 to execute    *** \n")
    (princ)
    A man who never made mistakes never made anything

Similar Threads

  1. Selection Set for Elements Inside Polyline (including Polyline)
    By bigd632 in forum AutoLISP, Visual LISP & DCL
    Replies: 5
    Last Post: 24th Feb 2015, 07:47 pm
  2. Replies: 24
    Last Post: 15th Mar 2013, 11:12 am
  3. Snap Polyline to the block insertion without changing the orientation of Polyline
    By Dhuliya_jay in forum AutoLISP, Visual LISP & DCL
    Replies: 1
    Last Post: 9th Oct 2011, 09:49 am
  4. Automatic Join Polyline onto existing Polyline ??
    By Leave Me Here in forum AutoCAD Beginners' Area
    Replies: 7
    Last Post: 19th Sep 2011, 12:13 am
  5. lisp to move largest room polyline to another layer for floor gross polyline
    By TheresaT in forum AutoLISP, Visual LISP & DCL
    Replies: 6
    Last Post: 25th Aug 2010, 07:11 pm

Tags for this Thread

Bookmarks

Posting Permissions

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