[编程交流] buble上的高度

(defun c:spou  (/ sp p)
 ;; Tharwat 15.Feb.2016 ;;
 (setq sp
        (vlax-get (vla-get-activelayout
                    (vla-get-ActiveDocument (vlax-get-acad-object)))
                  'Block)
       )
 (if (tblsearch "BLOCK" "spotu")
   (while (setq p (getpoint "\nSpecify point :"))
     (vla-put-textstring
       (car (vlax-invoke
              (vla-insertblock
                sp
                (vlax-3d-point p)
                "spotu"
                1.0
                1.0
                1.0
                0.0)
              'getattributes))
       
(rtos (/ (cadr p) 1000.) 2 2)
       )
     )
   )
 (princ)
 )(vl-load-com)

(defun C:test ( / e o p d )
(setvar 'errno 0)
(and
        vlax-get-acad-object
        (while (/= 52 (getvar 'errno))
                (setq e (car (nentsel "\nSelect text to fill: ")))
                (cond 
                        ((= 7 (getvar 'errno))
                                (princ "\nMissed, try again.") (setvar 'errno 0)
                        )
                        ((and e (not (vlax-property-available-p (setq o (vlax-ename->vla-object e)) 'TextString)))
                                (princ "\nThis is not a text object.") (setq e nil)
                        )
                        ((and o (eq (vla-get-Lock (vla-item (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-get-Layer o))) :vlax-true))
                                (princ "\nThis object is on a locked layer.") (setq e nil)
                        )
                        (e
                                (if 
                                        (and 
                                                (setq p (getpoint "\nSpecify first point: ")) 
                                                (cadr (setq p (cons p (list (getpoint "\nSpecify second point: " p)))))
                                                (setq d (rtos (abs (apply '- (mapcar 'last (mapcar '(lambda (x) (trans x 1 0)) p))))))
                                        )
                                        (cond
                                                ( (= "ATTDEF" (cdr (assoc 0 (entget e)))) (vla-put-TagString o d) )
                                                ( T (vla-put-TextString o d) )
                                        )
                                )
                                (setvar 'errno 52)
                        )
                        (T nil)
                )
        )
)
(princ)
);| defun |; (or vlax-get-acad-object (vl-load-com)) (princ)

(defun C:test ( / *error* p ar Atts a)
(defun *error* (m) (and ar (setvar 'attreq ar)) (print m) (princ))
(redraw)
(and
        vlax-get-acad-object
        (tblsearch "BLOCK" "spotu")
        (last (setq p (list (getpoint "\nSpecify first point: "))))
        (last (setq p (append p (list (getpoint "\nSpecify second point: " (car p))))))
        (not (apply 'grdraw (append p (list 3 7))))
        (last (setq p (append p (list (getpoint "\nSpecify insertion point :")))))        
        (or 
                (= 0 (getvar 'attreq))
                (and (setq ar (getvar 'attreq)) (setvar 'attreq 0))
        )
        (setq Atts
                (vlax-invoke
                        (vla-InsertBlock
                                (vlax-get (vla-get-activelayout (vla-get-ActiveDocument (vlax-get-acad-object))) 'Block)
                                (vlax-3D-point (last p))
                                "spotu"
                                1.0
                                1.0
                                1.0
                                0.0
                        )
                        'GetAttributes
                )
        )
        (setvar 'attreq (if ar ar 0))
        (vl-some '(lambda (x) (and (= (vla-get-TagString x) "22.22") (setq a x))) Atts)
        (vla-put-TextString 
                a
                (rtos 
                        (apply '- (mapcar 'last (mapcar '(lambda (x) (trans x 1 0)) (cdr (reverse p)))))
                        2 2
                )
        )
)
(redraw)
(princ)
);| defun |; (or vlax-get-acad-object (vl-load-com)) (princ)

(/       1000.)

(rtos 
(apply '- (mapcar 'last (mapcar '(lambda (x) (trans x 1 0)) (cdr (reverse p)))))
2 2
)

(rtos 
(/ (apply '- (mapcar 'last (mapcar '(lambda (x) (trans x 1 0)) (cdr (reverse p))))) 1000.)
2 2
)