飞时达方格原地貌标高改至指定值

树櫴希德

在基坑侧壁回填土方计算中，如果有支护桩或者地连墙支护，而且冠梁顶面有平台和放坡情况的话，（即原地貌横断面存在垂直边坡的情况）飞时达原地貌就不能随便编辑了，另外开一张图算了再粘贴过来又麻烦，此lisp是在先不编辑垂直坡地原地貌的情况下先计算，然后再修改，再重新计算，懒得另外开图（前提是支护桩底原地貌是平面）

1. ;; Set Attribute Values  -  Lee Mac 修改增强属性块属性
   
2. ;; Sets attributes with tags found in the association list to their associated values.
   
3. ;; blk - [vla] VLA Block Reference Object
   
4. ;; lst - [lst] Association list of ((<tag> . <value>) ... )
   
5. ;; Returns: nil
   
6. 
   
7. (defun LM:vl-setattributevalues ( blk lst / itm )
   
8.     (foreach att (vlax-invoke blk 'getattributes)
   
9.         (if (setq itm (assoc (vla-get-tagstring att) lst))
   
10.             (vla-put-textstring att (cdr itm))
    
11.         )
    
12.     )
    
13. )
    
14. 
    
15. ;(vla-get-tagstring (vlax-invoke (vlax-ename->vla-object (car (entsel))) 'getattributes) )
    
16. 
    
17. ; (vlax-invoke (vlax-ename->vla-object (car (entsel))) 'getattributes)
    
18. ;; Get Attribute Values  -  Lee Mac 获取增强属性块属性
    
19. ;; Returns an association list of attributes present in the supplied block.
    
20. ;; blk - [vla] VLA Block Reference Object
    
21. ;; Returns: [lst] Association list of ((<tag> . <value>) ... )
    
22. 
    
23. (defun LM:vl-getattributevalues ( blk )
    
24.     (mapcar '(lambda ( att ) (cons (vla-get-tagstring att) (vla-get-textstring att))) (vlax-invoke blk 'getattributes))
    
25. )
    
26. 
    
27. ;(setq lst '(("ZBG-BG" . "24444.85") ("SBG-BG" . "28888.81") ("SS-ZZ" . "8883.96") ("CDBG-BG" . "") ("SS-CD" . "") ("CD-ZZ" . "")))
    
28. ;(LM:vl-setattributevalues (vlax-ename->vla-object (car (entsel))) lst )
    
29. 
    
30. ;(cdr(assoc "ZBG-BG" '(("ZBG-BG" . "24.85") ("SBG-BG" . "28.81") ("SS-ZZ" . "3.96") ("CDBG-BG" . "") ("SS-CD" . "") ("CD-ZZ" . ""))))
    
31. 
    
32. 
    
33. (defun c:fsdbg  (  / ybtc aa1 lst zbg sbg ss-zz lsta blk)
    
34. (setq ybtc (vla-get-layer (vlax-ename->vla-object (car (entsel "\n请选择飞时达方格样本图元块："))) ) )
    
35.   (setq lsta (ssget "x" (list '(0 . "INSERT") (cons 8 ybtc )) ))
    
36. (setq i 0)
    
37. (setq aa1(getreal "\n请输入原地貌平面高程："))
    
38. (while  (< i (sslength lsta))
    
39. (setq blk (ssname lsta i))
    
40. (setq lst (LM:vl-getattributevalues (vlax-ename->vla-object blk)))
    
41. (setq sbg (read(cdr(assoc "SBG-BG" lst))) )
    
42.   (setq ss-zz (-  sbg aa1  ))
    
43.   (setq lst (subst (cons "ZBG-BG"  (rtos aa1 2 3))  (assoc "ZBG-BG" lst) lst) )      
    
44.   (setq lst (subst (cons "SS-ZZ"  (rtos ss-zz 2 3))  (assoc "SS-ZZ" lst) lst) )
    
45. ;(setq zbg (read(cdr(assoc "ZBG-BG" lst))) )
    
46. ;(setq ss-zz (read(cdr(assoc "SS-ZZ" lst))) )
    
47. 
    
48. (LM:vl-setattributevalues  (vlax-ename->vla-object blk) lst )
    
49.   (setq i (+ i 1))
    
50. 
    
51.   )
    
52. 
    
53. 
    
54. ;(vla-get-layer (vlax-ename->vla-object (car (entsel))) )
    
55. 
    
56. 
    
57. (princ)
    
58. )

;; Set Attribute Values  -  Lee Mac 修改增强属性块属性<br /> ;; Sets attributes with tags found in the association list to their associated values.<br /> ;; blk - [vla] VLA Block Reference Object<br /> ;; lst - [lst] Association list of ((<tag> . <value>) ... )<br /> ;; Returns: nil<br /> <br /> (defun LM:vl-setattributevalues ( blk lst / itm )<br />     (foreach att (vlax-invoke blk 'getattributes)<br />         (if (setq itm (assoc (vla-get-tagstring att) lst))<br />             (vla-put-textstring att (cdr itm))<br />         )<br />     )<br /> )<br /> <br /> ;(vla-get-tagstring (vlax-invoke (vlax-ename->vla-object (car (entsel))) 'getattributes) )<br /> <br /> ; (vlax-invoke (vlax-ename->vla-object (car (entsel))) 'getattributes)<br /> ;; Get Attribute Values  -  Lee Mac 获取增强属性块属性<br /> ;; Returns an association list of attributes present in the supplied block.<br /> ;; blk - [vla] VLA Block Reference Object<br /> ;; Returns: [lst] Association list of ((<tag> . <value>) ... )<br /> <br /> (defun LM:vl-getattributevalues ( blk )<br />     (mapcar '(lambda ( att ) (cons (vla-get-tagstring att) (vla-get-textstring att))) (vlax-invoke blk 'getattributes))<br /> )<br /> <br /> ;(setq lst '(("ZBG-BG" . "24444.85") ("SBG-BG" . "28888.81") ("SS-ZZ" . "8883.96") ("CDBG-BG" . "") ("SS-CD" . "") ("CD-ZZ" . "")))<br /> ;(LM:vl-setattributevalues (vlax-ename->vla-object (car (entsel))) lst )<br /> <br /> ;(cdr(assoc "ZBG-BG" '(("ZBG-BG" . "24.85") ("SBG-BG" . "28.81") ("SS-ZZ" . "3.96") ("CDBG-BG" . "") ("SS-CD" . "") ("CD-ZZ" . ""))))<br /> <br /> <br /> (defun c:fsdbg  (  / ybtc aa1 lst zbg sbg ss-zz lsta blk)<br /> (setq ybtc (vla-get-layer (vlax-ename->vla-object (car (entsel "\n请选择飞时达方格样本图元块："))) ) )<br />   (setq lsta (ssget "x" (list '(0 . "INSERT") (cons 8 ybtc )) )) <br /> (setq i 0)<br /> (setq aa1(getreal "\n请输入原地貌平面高程："))<br /> (while  (< i (sslength lsta))<br /> (setq blk (ssname lsta i))<br /> (setq lst (LM:vl-getattributevalues (vlax-ename->vla-object blk)))<br /> (setq sbg (read(cdr(assoc "SBG-BG" lst))) )<br />   (setq ss-zz (-  sbg aa1  ))<br />   (setq lst (subst (cons "ZBG-BG"  (rtos aa1 2 3))  (assoc "ZBG-BG" lst) lst) )      <br />   (setq lst (subst (cons "SS-ZZ"  (rtos ss-zz 2 3))  (assoc "SS-ZZ" lst) lst) )<br /> ;(setq zbg (read(cdr(assoc "ZBG-BG" lst))) )<br /> ;(setq ss-zz (read(cdr(assoc "SS-ZZ" lst))) )<br /> <br /> (LM:vl-setattributevalues  (vlax-ename->vla-object blk) lst )<br />   (setq i (+ i 1))<br /> <br />   )<br /> <br /> <br /> ;(vla-get-layer (vlax-ename->vla-object (car (entsel))) )<br /> <br /> <br /> (princ)<br /> )

树櫴希德

1. ;(vlax-get-or-create-object "Ket.application")
   
2. ;(vlax-get-or-create-object "Excel.application")
   
3. ;;提取 CAD 属性
   
4. (defun Get_Attrib (ed / o l)
   
5. (setq o (vlax-Ename->vla-Object ed))
   
6. (if (= (vla-Get-HasAttributes o) ':vlax-true)
   
7.     (mapcar '(lambda(x)(setq l (vl-list* (vla-Get-TagString x)(vla-Get-TextString x) l)))
   
8.         (vlax-safearray->list (vlax-variant-value (vla-GetAttributes o))))
   
9. )l
   
10. )
    
11. ;————————————————
    
12. ;版权声明：本文为CSDN博主「yxp_xa」的原创文章，遵循CC 4.0 BY-SA版权协议，转载请附上原文出处链接及本声明。
    
13. ;原文链接：https://blog.csdn.net/yxp_xa/article/details/72742260
    
14. ;(Get_Attrib (car(entsel)))
    
15. ;(Get_Attrib (car(entsel)))
    
16. ;选择对象: ("CD-ZZ" "" "SS-CD" "" "CDBG-BG" "" "SS-ZZ" "10.99" "SBG-BG" "25.62" "ZBG-BG" "14.63")
    

;(vlax-get-or-create-object "Ket.application")<br /> ;(vlax-get-or-create-object "Excel.application")<br /> ;;提取 CAD 属性<br /> (defun Get_Attrib (ed / o l)<br /> (setq o (vlax-Ename->vla-Object ed))<br /> (if (= (vla-Get-HasAttributes o) ':vlax-true)<br />     (mapcar '(lambda(x)(setq l (vl-list* (vla-Get-TagString x)(vla-Get-TextString x) l)))<br />         (vlax-safearray->list (vlax-variant-value (vla-GetAttributes o))))<br /> )l<br /> )<br /> ;————————————————<br /> ;版权声明：本文为CSDN博主「yxp_xa」的原创文章，遵循CC 4.0 BY-SA版权协议，转载请附上原文出处链接及本声明。<br /> ;原文链接：<a href="https://blog.csdn.net/yxp_xa/article/details/72742260" target="_blank">https://blog.csdn.net/yxp_xa/article/details/72742260</a><br /> ;(Get_Attrib (car(entsel)))<br /> ;(Get_Attrib (car(entsel)))<br /> ;选择对象: ("CD-ZZ" "" "SS-CD" "" "CDBG-BG" "" "SS-ZZ" "10.99" "SBG-BG" "25.62" "ZBG-BG" "14.63")<br />

树櫴希德

1. (setq doc(vla-get-ActiveDocument(vlax-get-acad-object)))
   
2. (setq bName (cdr(assoc 2 (entget (car(entsel))))))
   
3. 
   
4. (setq b(vla-item (vla-get-Blocks doc) bName))
   
5. 
   
6. (vla-AddAttribute b    1.5 8 "表示长度" (vlax-3D-point '(0 1 0)) "height" "777")
   
7. ;(command "attsync" "n" bname)  (entget(car(nentsel)))
   
8. (vla-AddAttribute b    1.5 8 "表示长度" (vlax-3D-point '(0 -1 0)) "height2" "666")

(setq doc(vla-get-ActiveDocument(vlax-get-acad-object)))<br /> (setq bName (cdr(assoc 2 (entget (car(entsel))))))<br /> <br /> (setq b(vla-item (vla-get-Blocks doc) bName))<br /> <br /> (vla-AddAttribute b    1.5 8 "表示长度" (vlax-3D-point '(0 1 0)) "height" "777")<br /> ;(command "attsync" "n" bname)  (entget(car(nentsel)))<br /> (vla-AddAttribute b    1.5 8 "表示长度" (vlax-3D-point '(0 -1 0)) "height2" "666")