选取对象中心画圆,高手在来改下吧，加条线上去，就很完美了

linheyuanpcb

(defun c:ab (/ ss r i minpt maxpt p)
     (prompt "\n快速建立中点,请框选对象")

(command "layer" "s" "0" "")
  (if (and (setq ss (ssget))
           (setq r 0.33)
      )
    (repeat (setq i (sslength ss))
      (setq i (1- i) a (vlax-ename->vla-object (ssname ss i)))
      (vla-getboundingbox a 'minpt 'maxpt)
      (mapcar 'set '(minpt maxpt) (mapcar 'vlax-safearray->list (list minpt maxpt)))
      (setq p (mapcar '(lambda (x y) (/ (+ x y) 2.0)) minpt maxpt))
      (entmake (list '(0 . "CIRCLE") (cons 10 p) (cons 40 r)))

(entmake (list '(0 . "line") ))

    )
  )

(command "layer" "s" "cut" "")
)

duotu007

(defun c:ab (/ ss r i minpt maxpt p p_r p_u p_l p_d)
  (prompt "\n快速建立中点,请框选对象")
  (command "layer" "s" "0" "")
  (if (and (setq ss (ssget))
           (setq r 0.33)
      )
    (repeat (setq i (sslength ss))
      (setq i (1- i) a (vlax-ename->vla-object (ssname ss i)))
      (vla-getboundingbox a 'minpt 'maxpt)
      (mapcar 'set '(minpt maxpt) (mapcar 'vlax-safearray->list (list minpt maxpt)))
      (setq p (mapcar '(lambda (x y) (/ (+ x y) 2.0)) minpt maxpt))
      (entmake (list '(0 . "CIRCLE") (cons 10 p) (cons 40 r)))
      ;;;增加线
      (setq p_r (polar p 0 (* r 1.3)))
      (setq p_u (polar p (* 0.5 pi) (* r 1.3)))
      (setq p_l (polar p pi (* r 1.3)))
      (setq p_d (polar p (* -0.5 pi) (* r 1.3)))
      (entmake (list '(0 . "line") (cons 10 p_r) (cons 11 p_l)))
      (entmake (list '(0 . "line") (cons 10 p_d) (cons 11 p_u)))
    )
  )
  (command "layer" "s" "cut" "")
)

啵浪鼓

楼上是增加十字线
楼下是增加一条到边界线
(defun c:ab (/ ss r i minpt maxpt p)
     (prompt "\n快速建立中点,请框选对象")

(command "layer" "s" "0" "")
  (if (and (setq ss (ssget))
           (setq r 0.33)
      )
    (repeat (setq i (sslength ss))
      (setq i (1- i) a (vlax-ename->vla-object (ssname ss i)))
      (vla-getboundingbox a 'minpt 'maxpt)
      (mapcar 'set '(minpt maxpt) (mapcar 'vlax-safearray->list (list minpt maxpt)))
      (setq p (mapcar '(lambda (x y) (/ (+ x y) 2.0)) minpt maxpt))
      (entmake (list '(0 . "CIRCLE") (cons 10 p) (cons 40 r)))
      ;;;增加一条到边界的线
      (entmake (list '(0 . "LINE") '(100 . "AcDbEntity") '(8 . "0")
                            '(67 . 0) '(62 . 1)
                             (cons 10 p) (cons 11 (list (car p) (cadr maxpt))))
      )

    )
  )
  (command "layer" "s" "cut" "")
)

linheyuanpcb

程序很好，如果能只在短边画就好了 因为竖着的话，线就变很长了[在长边，不是短边。]
能否加个判断？
又如，当所选短边>8.0mm时就画3.0mm线

lenlenq

画穿丝孔？

lincctw_ccl

應該是做穿絲孔的程式!!
雖然可自動繪製在圖元中心
但以這程式做穿線孔應該是放槍不斷!

功夫佬

duotu007 发表于 2011-4-30 15:06
(defun c:ab (/ ss r i minpt maxpt p p_r p_u p_l p_d)
  (prompt "\n快速建立中点,请框选对象")
  (com ...

找线段的中心点，能不能弄成自动在线段两端绘画圆，并成红色选中状态。可以方便检查有那条线是没有连接上。

690994

vla-getboundingbox求中心插入穿线孔，不是很理想吧，
一是对于小尺寸方形或圆形比较理想，对大尺寸图形线割引线就很长了，
比如100*100的引线就要50长了（穿线孔到边距离一般是3-4MM）浪费线割时间了，
二是对于一些弧状或L形等特殊图形，穿线孔就有可能落在图形外边了，
至于穿线孔到边线，可以通过求圆心到外形最近点再连线就可以了