[编程交流] 边界框问题

;|
PLEX CIRCLE OFFSET
DRAWS CLEARANCE HOLES AND OFFSETS CIRCLES FOR COUNTERSINK
WRITTEN BY P.DuMONT 02/18/2016 |;
(defun c:PLO ( / cmde doc osn dia ent obj point1 point2 ln sset mx d0 pt di )
 (defun *error* (msg)
   (if        (and msg
     (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
)
     (princ (strcat "\nError: " msg))
   )
   (if cmde
     (setvar 'cmdecho cmde)
     )
   (if        doc
     (vla-endundomark doc)
     )
   (if        osn
     (setvar 'osmode osn)
     )
   (princ)
 ) ;_ end of defun
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc)
 (setvar 'cmdecho 0)
 (setq osn (getvar 'osmode))
 (setvar 'osmode 0)
 
 (setq ent (car (entsel "\nSelect plex profile: ")))
; (command "_.ZOOM" "object" ent "")
 (setq dia 0.05)
 (setq obj (vlax-ename->vla-object ent))
 (vla-getboundingbox obj 'Point1 'Point2)
 (setq point1 (vlax-safearray->list Point1))
 (setq point2 (vlax-safearray->list Point2))
 (vla-offset obj -0.375)
 (command "_.explode" "l" "")
 (foreach ln
   (vl-remove-if
     'listp
     (mapcar 'cadr
             (ssnamex (ssget "_W" point1 point2 '((0 . "LINE"))))
     ) ;_ end of mapcar
   ) ;_ end of vl-remove-if
   (command
     "_.circle"
     (vlax-curve-getStartPoint ln)
     dia
     "_.circle"
     (vlax-curve-getEndPoint ln)
     dia
   ) ;_ end of command
 ) ;_ end of foreach
 
 (command "-overkill" "w" point1 point2 "" "")
 (setq di  ; HOLE SPACING
 (foreach ln
   (vl-remove-if
     'listp
     (mapcar 'cadr
             (ssnamex (ssget "_W" point1 point2 '((0 . "LINE"))))
     ) ;_ end of mapcar
   ) ;_ end of vl-remove-if
   (setq mx (vlax-curve-getdistatparam ln (vlax-curve-getendparam ln))
  d0 (- (/ (- mx (* di (fix (/ mx di)))) 2.) di)
   ) ;_ end of setq
   (while (and        (<= (setq d0 (+ d0 di)) mx)
        (setq pt (vlax-curve-getpointatdist ln d0))
   ) ;_ end of and
     (entmakex        (list (cons 0 "CIRCLE")
              (cons 10 pt)
              (cons 40 0.05)
              (cons 8 "0")
        ) ;_ end of list
     ) ;_ end of entmakex
   ) ;_ end of while
 ) ;_ end of foreach
 (setq sset (ssget "_W" point1 point2 '((0 . "LINE"))))
 (command "_.erase" sset "")
 
 (OffsetCircles)
 (command "_.ZOOM" "p")
 (setvar 'osmode osn)
 (vla-endundomark doc)
) ;_ end of defun
(vl-load-com)
;| OFFSET CIRCLES|;
(defun OffsetCircles (/ clay sset ent obj)
 (defun *error* (msg)
   (if        (and msg
     (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
)
     (princ (strcat "\nError: " msg))
   )
   (if        clay
     (setvar 'clayer clay)
   )
   (princ)
 ) ;_ end of defun
 (setq        clay (getvar 'clayer))
 (if (not (tblsearch "LAYER" "CNC_DRILL-0.10-PLEX"))
   (command "-layer"            "make"           "CNC_DRILL-0.10-PLEX"
     "color"            "T"                   "255,127,0" "" "") ;_ end of command
 ) ;_ end of if
 (if (not (tblsearch "LAYER" "CNC_DRILL-0.30-CNTRSINK"))
   (command "-layer"            "make"           "CNC_DRILL-0.30-CNTRSINK"
     "color"            "T"                   "255,127,159" "" "") ;_ end of command
 ) ;_ end of if
 
 (setvar 'clayer clay)
 (if (setq sset (ssget "_W" point1 point2 '((0 . "CIRCLE") (40 . 0.05))))
   (progn
     (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset)))
(vlax-put-property
  (vlax-ename->vla-object ent)
  'layer "CNC_DRILL-0.10-PLEX"
) ;_ end of vlax-put-property
(setq obj (vlax-ename->vla-object ent))
(vla-Offset obj 0.1)
(vlax-put-property
  (vlax-ename->vla-object (entlast))
  'layer "CNC_DRILL-0.30-CNTRSINK"
) ;_ end of vlax-put-property
     ) ;_ end of foreach
   ) ;_ end of progn
 ) ;_ end of if
 (princ)
) ;_ end of defun