[编程交流] 到属性块的距离

(defun c:FOO (/ pt)
 (if (setq pt (getpoint "\nSpecify base point: "))
   (while (and (not (initget 32))
               (/= nil (setq pt2 (getpoint pt "\nSpecify point to measure: "))))
     (prompt (strcat "\n  >>  Distance  >>  " (rtos (distance pt pt2) 2 2))))
   (prompt "\n** Invalid point ** "))
 (princ))

[b][color=BLACK]([/color][/b]defun c:ptd [b][color=FUCHSIA]([/color][/b]/ p1 p2 d3 d2 dx dy dz[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]initget 1[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq p1 [b][color=NAVY]([/color][/b]getpoint [color=#2f4f4f]"\n1st Point:   "[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]initget 1[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq p2 [b][color=NAVY]([/color][/b]getpoint p1 [color=#2f4f4f]"\n2nd Point:   "[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq d3 [b][color=NAVY]([/color][/b]distance p1 p2[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq d2 [b][color=NAVY]([/color][/b]distance [b][color=MAROON]([/color][/b]list [b][color=GREEN]([/color][/b]car p1[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]cadr p1[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
                    [b][color=MAROON]([/color][/b]list [b][color=GREEN]([/color][/b]car p2[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]cadr p2[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]princ [b][color=NAVY]([/color][/b]strcat [color=#2f4f4f]"\n3D="[/color] [b][color=MAROON]([/color][/b]rtos d3 2 2[b][color=MAROON])[/color][/b]
                [color=#2f4f4f]"\t2D="[/color] [b][color=MAROON]([/color][/b]rtos d2 2 2[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq dx [b][color=NAVY]([/color][/b]- [b][color=MAROON]([/color][/b]max [b][color=GREEN]([/color][/b]car p1[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]car p2[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]min [b][color=GREEN]([/color][/b]car p1[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]car p2[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq dy [b][color=NAVY]([/color][/b]- [b][color=MAROON]([/color][/b]max [b][color=GREEN]([/color][/b]cadr p1[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]cadr p2[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]min [b][color=GREEN]([/color][/b]cadr p1[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]cadr p2[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq dz [b][color=NAVY]([/color][/b]- [b][color=MAROON]([/color][/b]max [b][color=GREEN]([/color][/b]caddr p1[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]caddr p2[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]min [b][color=GREEN]([/color][/b]caddr p1[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]caddr p2[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]princ [b][color=NAVY]([/color][/b]strcat [color=#2f4f4f]"\nX Axis:"[/color] [b][color=MAROON]([/color][/b]rtos dx 2 2[b][color=MAROON])[/color][/b]
                [color=#2f4f4f]"\tY Axis:"[/color] [b][color=MAROON]([/color][/b]rtos dy 2 2[b][color=MAROON])[/color][/b]
                [color=#2f4f4f]"\tZ Axis:"[/color] [b][color=MAROON]([/color][/b]rtos dz 2 2[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

(defun C:test ( / *error* lst e )
(defun *error* (msg) (princ "\nSorry that I forced you to press Esc, to exit!") (princ))
(if (and (car (setq lst (list (getpoint "\nFirst point: ")))) (apply 'and (setq lst (append lst (list (getpoint "\nSecond point: " (car lst)))))))
        (while 
                (not 
                        (and 
                                (setq e (car (nentsel (strcat "\nDistance to fill is: "" (rtos (apply 'distance lst)) "" units, Select text/mtext/attrib."))))
                                (vl-position (cdr (assoc 0 (entget e))) '("TEXT" "MTEXT" "ATTRIB"))
                                (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString (list (vlax-ename->vla-object e) (rtos (apply 'distance lst))))))                
                        )
                )
                e
        )
)
(princ)
);| defun |; (or vlax-get-acad-object (vl-load-com)) (princ)