1. (defun c:tt (/ al-selectatpoint al-selectonscreen box e ebox i inobj lst maxpt minpt ss)
    2. (vl-load-com)
    3. (defun ebox (e / pa pb)
    4. (vla-GetBoundingBox e 'pa 'pb )
    5. (setq pa (trans (vlax-safearray->list pa) 0 1)
    6. pb (trans (vlax-safearray->list pb) 0 1)
    7. )
    8. (list pa pb)
    9. )
    10. (defun al-selectatpoint(opstr / util)
    11. (vl-load-com)
    12. (setq util (vla-get-utility (vla-get-activedocument (vlax-get-acad-object))))
    13. (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-getentity (list util 'obj 'ip opstr)))
    14. nil
    15. (progn
    16. ;(vla-Highlight obj 1)
    17. obj
    18. )
    19. )
    20. )
    21. (defun al-selectonscreen(lst / dxflst filter_code filter_value newset ssets thisdrawing)
    22. (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
    23. (setq ssets (vla-get-selectionsets thisdrawing))
    24. (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list ssets "SS1")))
    25. (setq newSet (vla-add ssets "SS1"))
    26. (progn
    27. (vla-delete (vla-item ssets "SS1"))
    28. (setq newSet (vla-add ssets "SS1"))
    29. )
    30. )
    31. (setq dxflst (list (mapcar 'car lst) (mapcar 'cdr lst)))
    32. (setq filter_code (vlax-make-safearray vlax-vbinteger (cons 0 (- (length (car dxflst)) 1))))
    33. (setq filter_value (vlax-make-safearray vlax-vbvariant (cons 0 (- (length (cadr dxflst)) 1))))
    34. (vlax-safearray-fill filter_code (car dxflst))
    35. (vlax-safearray-fill filter_value (cadr dxflst))
    36. (vla-selectOnScreen newSet filter_code filter_value)
    37. newSet
    38. )
    39. (if (setq inobj (al-selectatpoint "\n请选择需要添加外宽的块:"))
    40. (progn
    41. (setq ss (al-selectonscreen (list '(0 . "INSERT") (cons 2 (vla-get-Name inobj)))))
    42. (vlax-for item ss
    43. (setq box (ebox item) minpt (car box) maxpt (cadr box) lst (list minpt (list (car minpt) (cadr maxpt)) maxpt (list (car maxpt) (cadr minpt))))
    44. (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)) '(70 . 1)) (mapcar '(lambda (pt) (cons 10 pt)) lst)))
    45. )
    46. )
    47. )
    48. (princ)
    49. )