ldata词典应用

a117034423

2. (defun c:xbtt ( / ss2)
   
3.   (setq ss2 (ssget '(
   
4.                      (-4 . "<or")
   
5.                      (-4 . "<AND")
   
6.                      (0 . "LWPOLYLINE")
   
7.                      (8 . "板轮廓线")
   
8.                      (-4 . "AND>")
   
9.                      (-4 . "or>")
   
10.                             )
    
11.                    ))
    
12.   (xbttt ss2)
    
13.   )
    
14. (defun xbttt (ss0 / i tt1 form-txt form-pt ty1 n pt1)
    
15.   (defun form-txt (pt1 str1 clr /) ;创建文字函数
    
16.     (entmake (list
    
17.                '(0 . "TEXT")
    
18.                '(100 . "AcDbEntity")
    
19.                '(8 . "构件信息")
    
20.                '(100 . "AcDbText")
    
21.                '(7 . "tssd_rein")
    
22.                '(41 . 0.7)
    
23.                (cons 1 str1)
    
24.                (cons 10 pt1)
    
25.                (cons 11 pt1)
    
26.                (cons 40 80)
    
27.                (if clr
    
28.                (cons 62 clr)
    
29.                (cons 62 256)
    
30.                  )
    
31.                '(72 . 4)
    
32.                ))
    
33. )
    
34. (defun form-pt (ent1 / ptmin ptmax ptzz mod0 xcc dxy) ;求矩形中心点
    
35.   (setq mod0 (vl-remove nil (mapcar  '(lambda (x) (if (= (car x) 10) (cdr x))) (entget ent1)))
    
36.         ptmin (apply 'mapcar (cons 'min mod0))
    
37.         ptmax (apply 'mapcar (cons 'max mod0))
    
38.         dxy  (mapcar '- ptmax ptmin)
    
39.         ptzz  (mapcar '+ ptmax ptmin)
    
40.         ptzz  (list (* (car ptzz) 0.5) (* (cadr ptzz) 0.5) 0.0)
    
41.         xcc (vlax-ldata-get (vlax-ename->vla-object ent1) "XB")
    
42.         xcc (subst (cons "长度" (rtos (max (car dxy) (cadr dxy)) 2 0)) (assoc "长度" xcc) xcc)
    
43.         xcc (subst (cons "宽度" (rtos (min (car dxy) (cadr dxy)) 2 0)) (assoc "宽度" xcc) xcc)
    
44.         xcc (subst (cons "体积" (rtos (* (vlax-curve-getArea (vlax-ename->vla-object ent1)) (cdr (assoc "厚" xcc)) 1e-9) 2 2)) (assoc "体积" xcc) xcc)
    
45.         xcc (subst (cons "重量" (rtos (* (atof (cdr (assoc "体积" xcc))) 2.5) 2 2)) (assoc "重量" xcc) xcc)
    
46.         xcc (vlax-ldata-put (vlax-ename->vla-object ent1) "XB" xcc))
    
47.   ptzz
    
48.   )
    
49.   (setq i 0)
    
50.   (repeat (sslength ss0)
    
51.   (setq ty1 (ssname ss0 i)
    
52.         pt1 (form-pt ty1)
    
53.         tt1 (append (vlax-ldata-get (vlax-ename->vla-object ty1) "NO") (vlax-ldata-get (vlax-ename->vla-object ty1) "XB"))
    
54.         n 0
    
55.         i (1+ i)
    
56.         )
    
57.   (repeat (length tt1)
    
58.     (form-txt (list (car pt1) (+ (cadr pt1) (* (length tt1) 50)) 0.0) (strcat (car (nth n tt1)) " : " (if (/= (type (cdr (nth n tt1))) (type "str"))
    
59.                                                                                         (rtos (cdr (nth n tt1)) 2 0)
    
60.                                                                                         (cdr (nth n tt1)))) 256)
    
61.     (setq pt1 (list (car pt1) (- (cadr pt1) 100) 0.0)
    
62.           n  (1+ n)
    
63.           )
    
64.         )
    
65.     )
    
66.   (princ)
    
67.   )

(defun c:xbtt ( / ss2)<br />   (setq ss2 (ssget '(<br />                      (-4 . "<or")<br />                      (-4 . "<AND")<br />                      (0 . "LWPOLYLINE")<br />                      (8 . "板轮廓线")<br />                      (-4 . "AND>")<br />                      (-4 . "or>")<br />                             )<br />                    ))<br />   (xbttt ss2)<br />   )<br /> (defun xbttt (ss0 / i tt1 form-txt form-pt ty1 n pt1)<br />   (defun form-txt (pt1 str1 clr /) ;创建文字函数<br />     (entmake (list<br />                '(0 . "TEXT")<br />                '(100 . "AcDbEntity")<br />                '(8 . "构件信息")<br />                '(100 . "AcDbText")<br />                '(7 . "tssd_rein")<br />                '(41 . 0.7)<br />                (cons 1 str1)<br />                (cons 10 pt1)<br />                (cons 11 pt1)<br />                (cons 40 80)<br />                (if clr<br />                (cons 62 clr)<br />                (cons 62 256)<br />                  )<br />                '(72 . 4)<br />                ))<br /> )<br /> (defun form-pt (ent1 / ptmin ptmax ptzz mod0 xcc dxy) ;求矩形中心点<br />   (setq mod0 (vl-remove nil (mapcar  '(lambda (x) (if (= (car x) 10) (cdr x))) (entget ent1)))<br />         ptmin (apply 'mapcar (cons 'min mod0)) <br />         ptmax (apply 'mapcar (cons 'max mod0))<br />         dxy  (mapcar '- ptmax ptmin)<br />         ptzz  (mapcar '+ ptmax ptmin)<br />         ptzz  (list (* (car ptzz) 0.5) (* (cadr ptzz) 0.5) 0.0)<br />         xcc (vlax-ldata-get (vlax-ename->vla-object ent1) "XB")<br />         xcc (subst (cons "长度" (rtos (max (car dxy) (cadr dxy)) 2 0)) (assoc "长度" xcc) xcc)<br />         xcc (subst (cons "宽度" (rtos (min (car dxy) (cadr dxy)) 2 0)) (assoc "宽度" xcc) xcc)<br />         xcc (subst (cons "体积" (rtos (* (vlax-curve-getArea (vlax-ename->vla-object ent1)) (cdr (assoc "厚" xcc)) 1e-9) 2 2)) (assoc "体积" xcc) xcc)<br />         xcc (subst (cons "重量" (rtos (* (atof (cdr (assoc "体积" xcc))) 2.5) 2 2)) (assoc "重量" xcc) xcc)<br />         xcc (vlax-ldata-put (vlax-ename->vla-object ent1) "XB" xcc))<br />   ptzz<br />   )<br />   (setq i 0)<br />   (repeat (sslength ss0)<br />   (setq ty1 (ssname ss0 i)<br />         pt1 (form-pt ty1)<br />         tt1 (append (vlax-ldata-get (vlax-ename->vla-object ty1) "NO") (vlax-ldata-get (vlax-ename->vla-object ty1) "XB"))<br />         n 0<br />         i (1+ i)<br />         )<br />   (repeat (length tt1)<br />     (form-txt (list (car pt1) (+ (cadr pt1) (* (length tt1) 50)) 0.0) (strcat (car (nth n tt1)) " : " (if (/= (type (cdr (nth n tt1))) (type "str"))<br />                                                                                         (rtos (cdr (nth n tt1)) 2 0)<br />                                                                                         (cdr (nth n tt1)))) 256)<br />     (setq pt1 (list (car pt1) (- (cadr pt1) 100) 0.0)<br />           n  (1+ n)<br />           )<br />         )<br />     )<br />   (princ)<br />   )