Stationing to Attribute

April 27, 2011

Below is my code, though not working properly.

What it does:

Determines the stationing based on selecting a polyline, then the insertion of a block and stores that in the variable of statxt. What it also does is add a decimal to two spots after, such as 1+68.85.

What I would like to be able do...

Select the polyline, select a block and it fill in the stationing without decimals points on it to the attribute tag of STA. Ideally I would like to be able to do this by selecting a group of blocks and it fill in those values based on each blocks location at the same time.

(defun c:sdi ()(j))

(defun j (/ uicon ent ename sta
     ang ang-test stra dotpos statxt)
 (vl-load-com)
 (setvar "cmdecho" 0)
 (EXTEK_StartErrorTrap)

     (setq blocks (mapcar (function strcase)
       '("anchor-sta"
       "catch basin-sta"
       "conc. pole-sta"
       "elec transformer-sta"
       "fiber marker tube-sta"
       "fire hydrant-sta"
       "grate inlet-sta"
       "handhole-sta"
       "handhole prop-sta"
       "mailbox-sta"
       "manhole-sta"
       "parking meter-sta"
       "pole-sta"
       "property pin-sta"
       "sign-sta"
       "steel pole-sta"
       "steel post-sta"
       "street light-sta"
       "tel ped-sta"
       "test pit-sta"
       "traffic control box-sta"
       "traffic pole-sta"
       "traffic signal-sta"
       "tree-sta"
       "verizon mh-sta"
       "valve-sta"
       "water meter-sta")) i -1) 
 
 (setq uicon (getvar "ucsicon" ))
 (setvar "osmode" 44)
 ;(vl-cmdf "UCS" "w")
 (setq ent (entsel "\nSelect Running Line: ")
   ename (car ent))
 
 ;;;====Check if entsel is valid====
 (if (not ent)
   (progn
     (princ "\nMissed... try again!")
     (j)
     )
   )
 ;;;====End check===================

  (setq sta (vlax-curve-getDistAtPoint ename
   (setq on-pt (vlax-curve-getClosestPointTo ename
   (setq ox-pt (trans (getpoint "\nSelect Block Intersection" ) 1 0))))))

 (setq stra (rtos sta 2 2))
 
 (if (not (= stra "0.00"))
   (progn
     (setq dotpos (1+ (vl-string-search stra)))
      (substr stra (- dotpos 2))
       (if (>= (strlen stra) 6)
        (setq statxt (strcat (substr stra 1 (- dotpos 3)) "+"(substr stra (- dotpos 2))))
          (setq statxt (strcat (chr 48)"+" (substr stra (- dotpos 2))))
       )
     );progn
   (setq statxt "0+00")
   )

  (if
    (and
     (setq s1
       (ssget ":L"
         (list '(0 . "INSERT")
           (cons 2
             (apply 'strcat (cons "`*U*" (mapcar '(lambda ( s ) (strcat "," s)) blocks)))
           )                                                     ; End Cons
         )                                                    ; End list
       )                                                    ; End ssget
     )
   )                                                        ; End setq
   (while (setq e (ssname s1 (setq i (1+ i))))
     (if
       (and
         (vl-position
           (strcase
             (vlax-get-property (setq o (vlax-ename->vla-object e))
               (if (vlax-property-available-p o 'EffectiveName) 'EffectiveName 'Name)
             )
           )
           blocks
         )
         (eq (vla-get-isDynamicBlock o) :vlax-true)
       )
       (LM:SetDynamicPropValue o "STA" statxt)
     )
   )
 )                                                        ; End
 
 (EXTEK_EndErrorTrap)
 (setvar "cmdecho" 1)
 (princ (strcat "\n Stationing:" statxt ""))
 (princ)
 )



;;------------=={ Set Dynamic Property Value }==--------------;;
;;                                                            ;;
;;  Modifies the value of a Dynamic Block Property            ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  block - VLA Dynamic Block Reference Object                ;;
;;  prop  - Dynamic Block Property Name                       ;;
;;  value - New value for Property                            ;;
;;------------------------------------------------------------;;
;;  Returns: Value property was set to, else nil              ;;
;;------------------------------------------------------------;;

(defun LM:SetDynamicPropValue ( block prop value )
 (vl-some
   (function
     (lambda ( _prop )
       (if (eq prop (vla-get-propertyname _prop))
         (progn
           (vla-put-value _prop
             (vlax-make-variant value
               (vlax-variant-type (vla-get-value _prop))
             )
           )
           value
         )
       )
     )
   )
   (vlax-invoke block 'GetDynamicBlockProperties)
 )
)

April 27, 2011

You should really remove the beginning portion of your code that steps through and capitalizes each string and just type them out in capitals. The reason I had it that way in my original example because it was a subroutine and I couldn't guarantee the user would feed it an all caps string.

April 27, 2011

Here is an update, I think the coding is a bit more organized. Since I do use that list of blocks in a few other LISP, I just created a separate defun for it, to call them as needed.

This gets the value, displays it, and allows the user to select the block, but doesn't fill in the value for some reason. Though, I still am hoping to get this to where I can select the running line, the the group of blocks at the beginning and it fill out the value for the stationing, rounding up or down without any decimals.

Though, I still hope to ultimately get this to work by not having to select

(defun c:sdi ()(j))

(defun j (/ temperror *error* varlst oldvar uicon ent ename sta on-pt ox-pt ox-di
     ang ang-test stra dotpos statxt tot)
 (vl-load-com)
 (setvar "cmdecho" 0)
 (EXTEK_StartErrorTrap)
 
 (setq uicon (getvar "ucsicon" ))
 (setvar "osmode" 44)
 (setq ent (entsel "\nSelect Running Line: ")
   ename (car ent))
 (if (not ent)
   (progn
     (princ "\n`Missed... try again!")
     (j)
     )
   )

  (setq sta (vlax-curve-getDistAtPoint ename
   (setq on-pt (vlax-curve-getClosestPointTo ename
   (setq ox-pt (trans (getpoint "\nSelect Block Intersection" ) 1 0))))))

 (setq stra (rtos sta 2 2))
 (setq sta (rtos sta))
 
 (if (not (= stra "0.00"))
   (progn
     (setq dotpos (1+ (vl-string-search "." stra)))
      (substr stra (- dotpos 2))
       (if (>= (strlen stra) 6)
        (setq statxt (strcat (substr stra 1 (- dotpos 3)) "+"(substr stra (- dotpos 2))))
          (setq statxt (strcat (chr 48)"+" (substr stra (- dotpos 0))))
       )
     )
   (setq statxt "0+00")
   )

 (EXTEK_EndErrorTrap)
 (setvar "cmdecho" 1)
 (princ (strcat "\n Stationing:" statxt ""))
 (princ (strcat "\n Stationing:" sta ""))
 (stationvalue)
 (princ)
 )

(defun stationvalue ()
(EXTEK_StationBlocks)  
 (if
     (setq s1
       (ssget ":L"
         (list '(0 . "INSERT")
           (cons 2
             (apply 'strcat (cons "`*U*" (mapcar '(lambda ( s ) (strcat "," s)) blocks)))
           )                                                     ; End Cons
         )                                                    ; End list
       )                                                    ; End ssget
     )                                                        ; End setq
   (while (setq e (ssname s1 (setq i (1+ i))))
     (if
       (and
         (vl-position
           (strcase
             (vlax-get-property (setq o (vlax-ename->vla-object e))
               (if (vlax-property-available-p o 'EffectiveName) 'EffectiveName 'Name)
             )
           )
           blocks
         )
         (eq (vla-get-isDynamicBlock o) :vlax-true)
       )
       (LM:SetDynamicPropValue o "STA" statxt)
     )
   )
 ))

;;------------=={ Set Dynamic Property Value }==--------------;;
;;                                                            ;;
;;  Modifies the value of a Dynamic Block Property            ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  block - VLA Dynamic Block Reference Object                ;;
;;  prop  - Dynamic Block Property Name                       ;;
;;  value - New value for Property                            ;;
;;------------------------------------------------------------;;
;;  Returns: Value property was set to, else nil              ;;
;;------------------------------------------------------------;;

(defun LM:SetDynamicPropValue ( blocks prop value )
 (vl-some
   (function
     (lambda ( _prop )
       (if (eq prop (vla-get-propertyname _prop))
         (progn
           (vla-put-value _prop
             (vlax-make-variant value
               (vlax-variant-type (vla-get-value _prop))
             )
           )
           value
         )
       )
     )
   )
   (vlax-invoke blocks 'GetDynamicBlockProperties)
 )
)

April 28, 2011

ohnoto, can you post one typical block, then maybe we can find the bug(S)

Steve

April 28, 2011

Attached below... thanks!

manhole-sta.dwg

April 28, 2011

Hi Ohnoto,

I can see that you have been toiling with this for a while now in your past few threads, so I thought I'd see if I could lend a hand.

I have not tested the following code and, since I have never done any 'stationing', the code is mostly guesswork.

(defun c:test ( / blocks i l o s ss ) (vl-load-com)

 (setq blocks
  '(
     "ANCHOR-STA" 
     "CATCH BASIN-STA" 
     "CONC. POLE-STA" 
     "ELEC TRANSFORMER-STA" 
     "FIBER MARKER TUBE-STA" 
     "FIRE HYDRANT-STA" 
     "GRATE INLET-STA" 
     "HANDHOLE-STA" 
     "HANDHOLE PROP-STA" 
     "MAILBOX-STA" 
     "MANHOLE-STA" 
     "PARKING METER-STA" 
     "POLE-STA" 
     "PROPERTY PIN-STA" 
     "SIGN-STA" 
     "STEEL POLE-STA" 
     "STEEL POST-STA" 
     "STREET LIGHT-STA" 
     "TEL PED-STA" 
     "TEST PIT-STA" 
     "TRAFFIC CONTROL BOX-STA" 
     "TRAFFIC POLE-STA" 
     "TRAFFIC SIGNAL-STA" 
     "TREE-STA" 
     "VERIZON MH-STA" 
     "VALVE-STA" 
     "WATER METER-STA"
   )
 )

 (if
   (and
     (setq l
       (LM:Select "\nSelect Running Line: "
        '(lambda ( x )
           (not
             (vl-catch-all-error-p
               (vl-catch-all-apply 'vlax-curve-getendparam (list x))
             )
           )
         )
         entsel
       )
     )
     (princ "\nSelect Dynamic Blocks: ")
     (setq ss
       (ssget "_:L"
         (list '(0 . "INSERT")
           (cons 2
             (apply 'strcat (cons "`*U*" (mapcar '(lambda ( s ) (strcat "," s)) blocks)))
           )
         )
       )
     )
   )
   (repeat (setq i (sslength ss))
     (if
       (and
         (member
           (strcase
             (vlax-get-property (setq o (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
               (if (vlax-property-available-p o 'EffectiveName) 'EffectiveName 'Name)
             )
           )
           blocks
         )
         (eq (vla-get-isDynamicBlock o) :vlax-true)
         (setq s
           (vlax-curve-getdistatpoint l
             (vlax-curve-getclosestpointto l (vlax-get o 'insertionpoint))
           )
         )
       )
       (LM:SetDynamicPropValue o "STA" (vl-string-subst "+" "." (rtos s 2 2)))
     )
   )
 )

 (princ)
)

;;------------=={ Set Dynamic Property Value }==--------------;;
;;                                                            ;;
;;  Modifies the value of a Dynamic Block Property            ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  block - VLA Dynamic Block Reference Object                ;;
;;  prop  - Dynamic Block Property Name                       ;;
;;  value - New value for Property                            ;;
;;------------------------------------------------------------;;
;;  Returns: Value property was set to, else nil              ;;
;;------------------------------------------------------------;;

(defun LM:SetDynamicPropValue ( block prop value ) (setq prop (strcase prop))
 (vl-some
   (function
     (lambda ( _prop )
       (if (eq prop (strcase (vla-get-propertyname _prop)))
         (progn
           (vla-put-value _prop
             (vlax-make-variant value
               (vlax-variant-type (vla-get-value _prop))
             )
           )
           value
         )
       )
     )
   )
   (vlax-invoke block 'GetDynamicBlockProperties)
 )
)

;;---------------------=={ Select if }==----------------------;;
;;                                                            ;;
;;  Continuous selection prompts until a predicate function   ;;
;;  is validated                                              ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  msg  - prompt string                                      ;;
;;  pred - optional predicate function taking ename argument  ;;
;;  func - selection function to invoke                       ;;
;;------------------------------------------------------------;;
;;  Returns:  selected entity ename if successful, else nil   ;;
;;------------------------------------------------------------;;

(defun LM:Select ( msg pred func / e ) (setq pred (eval pred))  
 (while
   (progn (setvar 'ERRNO 0) (setq e (car (func msg)))
     (cond
       ( (= 7 (getvar 'ERRNO))

         (princ "\n** Missed, Try again **")
       )
       ( (eq 'ENAME (type e))

         (if (and pred (not (pred e)))
           (princ "\n** Invalid Object Selected **")
         )
       )
     )
   )
 )
 e
)

HTH

Edited April 28, 2011 by Lee Mac

April 28, 2011

BTW, if the dynamics blocks all end in '-STA' you could vastly simplify your ssget filter to just:

(ssget "_:L" '((0 . "INSERT") (2 . "`*U*,*-STA")))

April 28, 2011

Thanks Lee, it is closer to what I am looking for. I see what you did with the code with the trying to determine the stationing. However, nothing got put into the STA value.

To see what value was being returned, I had "L" print to the command line and I get "error: bad argument type: stringp ".

Edit: Thanks for that tip ^^

April 28, 2011

Thanks Lee, it is closer to what I am looking for. I see what you did with the code with the trying to determine the stationing. However, nothing got put into the STA value.

Maybe it was a case-sensivity issue with the property name - I have tweaked my subfunction, please try the above code again.

To see what value was being returned, I had "L" print to the command line and I get "error: bad argument type: stringp ".

'l' is the entityname of the selected line, not the value - 's' is the value.

April 28, 2011

Whoops... was reading that variable. Ok, similar error:

; error: bad argument type: stringp 77.5725

Which in my testing 77.5725 is the correct length from the beginning on of the line.

April 28, 2011

Have you modified my code at all?

I don't see where that error could come from.

April 28, 2011

The only thing I added was

(princ (strcat "\nStationing" s ""))

before the last princ.

April 28, 2011

Well that is what is causing the error since 's' is not a string.

April 28, 2011

After querying your attached example block using my 'GetDynamicProperties' function from here, I notice that it doesn't even have a property called 'STA' which is probably why no value is being assigned.

April 28, 2011

Ah, I see that now. I had added that just to see a visual verification of the value. Sorry for the confusion.

Which now goes back to the original issue still, in that the value isn't being put in for the STA attribute tag, even with the updated code you had.

April 28, 2011

Yeah, it's an attribute tag... I thought that the dynamic property applied to any property, not just specifically dynamic objects, even though the tag is in a dynamic block.

April 28, 2011

Yeah, it's an attribute tag... I thought that the dynamic property applied to any property, not just specifically dynamic objects, even though the tag is in a dynamic block.

No, attributes are another matter entirely.

April 28, 2011

Try this:

(defun c:test ( / blocks i l o s ss ) (vl-load-com)

 (setq blocks
  '(
     "ANCHOR-STA" 
     "CATCH BASIN-STA" 
     "CONC. POLE-STA" 
     "ELEC TRANSFORMER-STA" 
     "FIBER MARKER TUBE-STA" 
     "FIRE HYDRANT-STA" 
     "GRATE INLET-STA" 
     "HANDHOLE-STA" 
     "HANDHOLE PROP-STA" 
     "MAILBOX-STA" 
     "MANHOLE-STA" 
     "PARKING METER-STA" 
     "POLE-STA" 
     "PROPERTY PIN-STA" 
     "SIGN-STA" 
     "STEEL POLE-STA" 
     "STEEL POST-STA" 
     "STREET LIGHT-STA" 
     "TEL PED-STA" 
     "TEST PIT-STA" 
     "TRAFFIC CONTROL BOX-STA" 
     "TRAFFIC POLE-STA" 
     "TRAFFIC SIGNAL-STA" 
     "TREE-STA" 
     "VERIZON MH-STA" 
     "VALVE-STA" 
     "WATER METER-STA"
   )
 )

 (if
   (and
     (setq l
       (LM:Select "\nSelect Running Line: "
        '(lambda ( x )
           (not
             (vl-catch-all-error-p
               (vl-catch-all-apply 'vlax-curve-getendparam (list x))
             )
           )
         )
         entsel
       )
     )
     (princ "\nSelect Dynamic Blocks: ")
     (setq ss
       (ssget "_:L"
         (list '(0 . "INSERT") '(66 . 1)
           (cons 2
             (apply 'strcat (cons "`*U*" (mapcar '(lambda ( s ) (strcat "," s)) blocks)))
           )
         )
       )
     )
   )
   (repeat (setq i (sslength ss))
     (if
       (and
         (member
           (strcase
             (vlax-get-property (setq o (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
               (if (vlax-property-available-p o 'EffectiveName) 'EffectiveName 'Name)
             )
           )
           blocks
         )
         (setq s
           (vlax-curve-getdistatpoint l
             (vlax-curve-getclosestpointto l (vlax-get o 'insertionpoint))
           )
         )
       )
       (LM:SetAttributeValue o "STA" (vl-string-subst "+" "." (rtos (/ s 100.) 2 2)))
     )
   )
 )

 (princ)
)

;;----------------=={ Set Attribute Value }==-----------------;;
;;                                                            ;;
;;  Populates the first attribute matching the tag specified  ;;
;;  found within the block supplied with the value specified, ;;
;;  if present.                                               ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  block - VLA Block Reference Object                        ;;
;;  tag   - Attribute TagString                               ;;
;;  value - Value to which the Attribute will be set          ;;
;;------------------------------------------------------------;;
;;  Returns:  Value the attribute was set to, else nil        ;;
;;------------------------------------------------------------;;

(defun LM:SetAttributeValue ( block tag value ) (setq tag (strcase tag))
 (vl-some
   (function
     (lambda ( attrib )
       (if (eq tag (strcase (vla-get-TagString attrib)))
         (progn (vla-put-TextString attrib value) value)
       )
     )
   )
   (vlax-invoke block 'GetAttributes)
 )
)

;;---------------------=={ Select if }==----------------------;;
;;                                                            ;;
;;  Continuous selection prompts until a predicate function   ;;
;;  is validated                                              ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  msg  - prompt string                                      ;;
;;  pred - optional predicate function taking ename argument  ;;
;;  func - selection function to invoke                       ;;
;;------------------------------------------------------------;;
;;  Returns:  selected entity ename if successful, else nil   ;;
;;------------------------------------------------------------;;

(defun LM:Select ( msg pred func / e ) (setq pred (eval pred))  
 (while
   (progn (setvar 'ERRNO 0) (setq e (car (func msg)))
     (cond
       ( (= 7 (getvar 'ERRNO))

         (princ "\n** Missed, Try again **")
       )
       ( (eq 'ENAME (type e))

         (if (and pred (not (pred e)))
           (princ "\n** Invalid Object Selected **")
         )
       )
     )
   )
 )
 e
)

Edited April 28, 2011 by Lee Mac

April 28, 2011

Close... oh so close...

For the value of 77.5725, the stationing would be 0+78, but it put the value of 77+57.

as another example, If the footage was 1058.4878, the stationing would be 10+58, 105687.4578 would be 1056+87.

April 28, 2011

Lee, got to divide the sta value by 100

Sign In

Stationing to Attribute

Recommended Posts

Ohnoto

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

alanjt

Ohnoto

stevesfr

Ohnoto

Lee Mac

Lee Mac

Ohnoto

Lee Mac

Ohnoto

Lee Mac

Ohnoto

Lee Mac

Lee Mac

Ohnoto

Ohnoto

Lee Mac

Lee Mac

Ohnoto

stevesfr

Join the conversation

Tutorials

Forums

Activity