Topic: Stationing Lisp

[Scott]

Fatty

You are the man!!!

This works perfect.

Thanks for the help.

Scott

[Fatty]

Always happy to help, but I have not have
a time to varnish it
Change to your suit by yourself

Cheers

~'J'~

[Jeff_M]

As usual I'm a bit late to the party. Anyway, here's my offering which allows the beginning station to be any number, which happens often for me when tying to existing designs. I also use the existing STA block, if it exists in the drawing but does not have an attribute for the Station then I add it to the block def.

Code: [Select]

(defun c:station (/ ANG ATT ATTS BLK BLKREF DERV DOC ENT LINE PAD PARM SPACE STA TMPSTA)
  (vl-load-com)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (if (not (tblsearch "block" "sta"))
    (progn
      (setq blk (vlax-invoke (vla-get-blocks doc) 'add '(0.0 0.0 0.0) "sta"))
      (setq line (vlax-invoke blk 'addline '(0.0 31.25 0.0) '(0.0 -31.25 0.0)))
      (vla-put-layer line "0")
      (vla-put-color line acbylayer)
      (setq att (vlax-invoke blk 'addattribute
  15.0
  acAttributeModeNormal
  "Station number?: "
  '(0.0 35.0 0.0)
  "STATION"
  "0+00"))
      (vla-put-layer att "0")
      (vla-put-color att acbylayer)
      )
    (if (and (setq blk (vla-item (vla-get-blocks doc) "sta"))
     (= (vla-get-count blk) 1)
     )
      (progn
(setq att (vlax-invoke blk 'addattribute
  15.0
  acAttributeModeNormal
  "Station number?: "
  '(0.0 35.0 0.0)
  "STATION"
  "0+00"))
(vla-put-layer att "0")
(vla-put-color att acbylayer)
(vla-put-rotation att (* pi 1.5))
(vla-put-alignment att acAlignmentMiddleRight)
(vlax-put att 'TextAlignmentPoint '(0.0 35.0 0.0))
)
      )
    )
  (while (and (setq ent (car (entsel)))
      (setq sta (getreal "Starting station: "))
      )
    (setq tmpsta (fix (/ sta 100))
  pad (- sta (* tmpsta 100.0))
  space (vla-get-modelspace doc)
  )
    (if (/= pad 0.0)
      (setq tmpsta (1+ tmpsta))
      )
    (while (<= (* tmpsta 100) (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)))
      (setq parm (vlax-curve-getparamatdist ent (- (* tmpsta 100.0) pad)))
      (setq derv (vlax-curve-getfirstderiv ent parm))
      (if (= (car derv) 0.0)
(setq ang (/ pi 2))
(setq ang (atan (/ (cadr derv) (car derv))))
)
      (setq blkref (vlax-invoke space 'insertblock (vlax-curve-getpointatparam ent parm) "sta" 1.0 1.0 1.0 ang))
      (setq atts (vlax-invoke blkref 'getattributes))
      (setq att (car atts))
      (vla-put-textstring att (strcat (itoa tmpsta) "+00"))
      (setq tmpsta (1+ tmpsta))
      )
    )
  (princ)
  )


[Fatty]

Huh,
You beat me again
Brilliance one, Jeff

Regards
 :kewl:
~'J'~