定位到属性
下面是我的代码，虽然工作不正常。它的作用：
基于选择多段线，然后插入块来确定桩号，并将其存储在statxt变量中。它还可以在后面的两个点上加一个小数，例如1+68.85。
我想做的是。。。
选择多段线，选择一个块，然后将其填充到STA的属性标记上，该点上没有小数点。理想情况下，我希望能够通过选择一组块来实现这一点，并根据每个块的位置同时填充这些值。
(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)
)
) 您应该真正删除代码的开头部分，该部分逐步完成并将每个字符串大写，然后用大写字母键入。我在最初的示例中这样做的原因是因为它是一个子例程，我不能保证用户会向它提供一个全大写字符串。 这是一个更新，我认为编码更有条理。因为我在其他几个LISP中使用了这个块列表，所以我只是为它创建了一个单独的defun，根据需要调用它们。
这将获取值，显示它，并允许用户选择块，但由于某种原因不会填充值。尽管如此，我仍然希望能够在这里选择运行线，在开始时选择一组块，然后填充定位值，向上或向下取整，不带任何小数。
尽管如此，我仍然希望通过不必选择最终实现这一点
(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)
)
) ohnoto，你能发布一个典型的块吗，然后也许我们可以找到错误
史蒂夫 附件如下。。。谢谢
人孔sta。图纸 嗨，Ohnoto，
我可以看出，在过去的几行文章中，你已经为此操劳了一段时间，所以我想看看是否可以帮上忙。
我没有测试过以下代码，因为我从未做过任何“定位”，所以代码大多是猜测。
(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 顺便说一句，如果动态块都以“-STA”结尾，您可以将ssget过滤器大大简化为：
(ssget "_:L" '((0 . "INSERT") (2 . "`*U*,*-STA"))) 谢谢李，它更接近我想要的。我看到你们在试图确定站点时对代码做了什么。然而，STA值中没有任何值。
为了查看返回了什么值，我在命令行中打印了“L”，并得到“错误：错误的参数类型：stringp”。
编辑：谢谢你的提示^
可能是属性名的大小写敏感度问题-我已经调整了我的子函数，请重试上述代码。
“l”是所选行的entityname，而不是值-“s”是值。 哎呀。。。正在读取该变量。好的，类似错误：
; 错误：错误的参数类型：stringp 77.5725
在我的测试77.5725中，这是从线路开始的正确长度。
页:
[1]
2