飞时达方格原地貌标高改至指定值
在基坑侧壁回填土方计算中，如果有支护桩或者地连墙支护，而且冠梁顶面有平台和放坡情况的话，（即原地貌横断面存在垂直边坡的情况）飞时达原地貌就不能随便编辑了，另外开一张图算了再粘贴过来又麻烦，此lisp是在先不编辑垂直坡地原地貌的情况下先计算，然后再修改，再重新计算，懒得另外开图（前提是支护桩底原地貌是平面）;; Set Attribute Values-Lee Mac 修改增强属性块属性
;; Sets attributes with tags found in the association list to their associated values.
;; blk - VLA Block Reference Object
;; lst - Association list of ((<tag> . <value>) ... )
;; Returns: nil
(defun LM:vl-setattributevalues ( blk lst / itm )
(foreach att (vlax-invoke blk 'getattributes)
(if (setq itm (assoc (vla-get-tagstring att) lst))
(vla-put-textstring att (cdr itm))
)
)
)
;(vla-get-tagstring (vlax-invoke (vlax-ename->vla-object (car (entsel))) 'getattributes) )
; (vlax-invoke (vlax-ename->vla-object (car (entsel))) 'getattributes)
;; Get Attribute Values-Lee Mac 获取增强属性块属性
;; Returns an association list of attributes present in the supplied block.
;; blk - VLA Block Reference Object
;; Returns: Association list of ((<tag> . <value>) ... )
(defun LM:vl-getattributevalues ( blk )
(mapcar '(lambda ( att ) (cons (vla-get-tagstring att) (vla-get-textstring att))) (vlax-invoke blk 'getattributes))
)
;(setq lst '(("ZBG-BG" . "24444.85") ("SBG-BG" . "28888.81") ("SS-ZZ" . "8883.96") ("CDBG-BG" . "") ("SS-CD" . "") ("CD-ZZ" . "")))
;(LM:vl-setattributevalues (vlax-ename->vla-object (car (entsel))) lst )
;(cdr(assoc "ZBG-BG" '(("ZBG-BG" . "24.85") ("SBG-BG" . "28.81") ("SS-ZZ" . "3.96") ("CDBG-BG" . "") ("SS-CD" . "") ("CD-ZZ" . ""))))
(defun c:fsdbg(/ ybtc aa1 lst zbg sbg ss-zz lsta blk)
(setq ybtc (vla-get-layer (vlax-ename->vla-object (car (entsel "\n请选择飞时达方格样本图元块："))) ) )
(setq lsta (ssget "x" (list '(0 . "INSERT") (cons 8 ybtc )) ))
(setq i 0)
(setq aa1(getreal "\n请输入原地貌平面高程："))
(while(< i (sslength lsta))
(setq blk (ssname lsta i))
(setq lst (LM:vl-getattributevalues (vlax-ename->vla-object blk)))
(setq sbg (read(cdr(assoc "SBG-BG" lst))) )
(setq ss-zz (-sbg aa1))
(setq lst (subst (cons "ZBG-BG"(rtos aa1 2 3))(assoc "ZBG-BG" lst) lst) )
(setq lst (subst (cons "SS-ZZ"(rtos ss-zz 2 3))(assoc "SS-ZZ" lst) lst) )
;(setq zbg (read(cdr(assoc "ZBG-BG" lst))) )
;(setq ss-zz (read(cdr(assoc "SS-ZZ" lst))) )
(LM:vl-setattributevalues(vlax-ename->vla-object blk) lst )
(setq i (+ i 1))
)
;(vla-get-layer (vlax-ename->vla-object (car (entsel))) )
(princ)
)
;(vlax-get-or-create-object "Ket.application")
;(vlax-get-or-create-object "Excel.application")
;;提取 CAD 属性
(defun Get_Attrib (ed / o l)
(setq o (vlax-Ename->vla-Object ed))
(if (= (vla-Get-HasAttributes o) ':vlax-true)
(mapcar '(lambda(x)(setq l (vl-list* (vla-Get-TagString x)(vla-Get-TextString x) l)))
(vlax-safearray->list (vlax-variant-value (vla-GetAttributes o))))
)l
)
;————————————————
;版权声明：本文为CSDN博主「yxp_xa」的原创文章，遵循CC 4.0 BY-SA版权协议，转载请附上原文出处链接及本声明。
;原文链接：https://blog.csdn.net/yxp_xa/article/details/72742260
;(Get_Attrib (car(entsel)))
;(Get_Attrib (car(entsel)))
;选择对象: ("CD-ZZ" "" "SS-CD" "" "CDBG-BG" "" "SS-ZZ" "10.99" "SBG-BG" "25.62" "ZBG-BG" "14.63")
(setq doc(vla-get-ActiveDocument(vlax-get-acad-object)))
(setq bName (cdr(assoc 2 (entget (car(entsel))))))
(setq b(vla-item (vla-get-Blocks doc) bName))
(vla-AddAttribute b 1.5 8 "表示长度" (vlax-3D-point '(0 1 0)) "height" "777")
;(command "attsync" "n" bname)(entget(car(nentsel)))
(vla-AddAttribute b 1.5 8 "表示长度" (vlax-3D-point '(0 -1 0)) "height2" "666") 很好→很棒！很好~很棒！！很好……很棒！！！
:victory:看看下载试试
页:
[1]