定位到属性

Ohnoto · 发表于 2022-7-6 09:33:42

下面是我的代码，虽然工作不正常。

它的作用：
基于选择多段线，然后插入块来确定桩号，并将其存储在statxt变量中。它还可以在后面的两个点上加一个小数，例如1+68.85。

我想做的是。。。
选择多段线，选择一个块，然后将其填充到STA的属性标记上，该点上没有小数点。理想情况下，我希望能够通过选择一组块来实现这一点，并根据每个块的位置同时填充这些值。

copy


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

alanjt · 发表于 2022-7-6 09:37:54

您应该真正删除代码的开头部分，该部分逐步完成并将每个字符串大写，然后用大写字母键入。我在最初的示例中这样做的原因是因为它是一个子例程，我不能保证用户会向它提供一个全大写字符串。

Ohnoto · 发表于 2022-7-6 09:41:41

这是一个更新，我认为编码更有条理。因为我在其他几个LISP中使用了这个块列表，所以我只是为它创建了一个单独的defun，根据需要调用它们。

这将获取值，显示它，并允许用户选择块，但由于某种原因不会填充值。尽管如此，我仍然希望能够在这里选择运行线，在开始时选择一组块，然后填充定位值，向上或向下取整，不带任何小数。

尽管如此，我仍然希望通过不必选择最终实现这一点

copy


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

stevesfr · 发表于 2022-7-6 09:45:37

ohnoto，你能发布一个典型的块吗，然后也许我们可以找到错误
史蒂夫

Ohnoto · 发表于 2022-7-6 09:48:12

附件如下。。。谢谢
人孔sta。图纸

Lee Mac · 发表于 2022-7-6 09:52:42

嗨，Ohnoto，

我可以看出，在过去的几行文章中，你已经为此操劳了一段时间，所以我想看看是否可以帮上忙。

我没有测试过以下代码，因为我从未做过任何“定位”，所以代码大多是猜测。

copy

(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

Lee Mac · 发表于 2022-7-6 09:54:12

顺便说一句，如果动态块都以“-STA”结尾，您可以将ssget过滤器大大简化为：

copy

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

Ohnoto · 发表于 2022-7-6 09:57:18

谢谢李，它更接近我想要的。我看到你们在试图确定站点时对代码做了什么。然而，STA值中没有任何值。

为了查看返回了什么值，我在命令行中打印了“L”，并得到“错误：错误的参数类型：stringp”。

编辑：谢谢你的提示^

Lee Mac · 发表于 2022-7-6 10:00:46

可能是属性名的大小写敏感度问题-我已经调整了我的子函数，请重试上述代码。

“l”是所选行的entityname，而不是值-“s”是值。

Ohnoto · 发表于 2022-7-6 10:05:01

哎呀。。。正在读取该变量。好的，类似错误：

; 错误：错误的参数类型：stringp 77.5725

在我的测试77.5725中，这是从线路开始的正确长度。

[编程交流] 定位到属性

发表回复

精选推荐