[编程交流] 定位到属性

(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
)