自动画穿线孔

yxl88168

(defun c:czk()(setq cmd(getvar "cmdecho"))
             (setvar "cmdecho" 0)
             (setq pl(getpoint "\nselect a point:"))
             (command "circle" "none" pl 1.5 )
             (command "line" "none" "@-2,0" "none" "@4,0" "")
             (command "line" "none" "@-2,-2" "none" "@0,4" "")
             (setvar "cmdecho" cmd))


上面是一个画穿线孔的程序，但是它只能画出孔来，不能将它变成一个块，谁能给它加上画出穿线孔后变成图块啊，谢谢大家了

lenlenq

为什么要做块。编程的时只要把块炸开。要做块不难！

linheyuanpcb

defun c:ah()
(vl-load-com)
(command "undo" be)
(princ "/n请选取要加引线孔的槽孔 POLYLINE:")
(setq hy_ms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(setq ss (ssget '((0 . "*POLYLINE") (70 . 1) (90 . 4))));对POLYLINE图形有效
;(setq ss (ssget '((0 . "line") )))  ---这里是对线条有效,
(setq k 0)
;(command "pedit" "m" ss "" "y" "j" "" "")
(setq ent (entlast))
;(repeat (sslength ss)
;(setq ent (ssname ss k))
(vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint )
(setq maxpoint (vlax-safearray->list maxpoint)
minpoint (vlax-safearray->list minpoint)
maxpoint (trans maxpoint 0 1)
minpoint (trans minpoint 0 1)
mx (/ (+ (car maxpoint) (car minpoint)) 2.0)
my (/ (+ (cadr maxpoint) (cadr minpoint)) 2.0)
dx (/ (- (car maxpoint) (car minpoint)) 2.0)
dy (/ (- (cadr maxpoint) (cadr minpoint)) 2.0)
mpt (list mx my)
)
(cond
((> dx dy)(setq mpt1 (list mx (+ my dy))))
((< dx dy)(setq mpt1 (list (+ mx dx) my)))
)
(command "layer" "s" "4" "")
;(command "line" mpt mpt1 "")
(command "layer" "s" "0" "")
(command "circle" mpt "0.33")
(vla-addline hy_ms (vlax-3d-point (trans mpt 1 0)) (vlax-3d-point (trans mpt1 1 0)))
(setq k (1+ k))
;)
;(command "explode" ent)
;(command "undo" e)
(command "layer" "s" "cut" "")
)

这个相对小些的图形用来画还OK，因为是在中心画线和圆，
，

yxl88168

回复 lenlenq 的帖子

公司的习惯，我们这里是这样的，所以想问问大家有没有这样的程序，请楼主指教

yxl88168

回复 linheyuanpcb 的帖子

谢谢楼主的程序，只是穿线孔爱跑到别的地方去了，愿楼主再改一改

461045462

回复 linheyuanpcb 的帖子


怪，加载不了，与我的程序方式冲突，慢慢看看
谢谢楼主的分享

yoyoho

谢谢楼主的分享

linheyuanpcb

(command "pedit" "m" ss "" "y" "j" "" "")
把它炸开就行了

linheyuanpcb

这个不好用，
试下这个吧，虽然不能批量放，但也比线圆这样去画
两点中心画引线孔[输入距离或点取距离/2 中心处]

(defun c:tt (/ pt1 pt2 pt12 bj)
(princ "/n两点中心放置线切割引线+0.66mm孔:")
(setq bj 0.33);这里修改圆孔的半径  
(setq pt1 (getpoint "\n点取第一点:")
  pt2 (getpoint pt1 "\n点取第二点:")
  pt12 (list   
(* 0.5 (+ (nth 0 pt1) (nth 0 pt2)))  
(* 0.5 (+ (nth 1 pt1) (nth 1 pt2)))   
(* 0.5 (+ (nth 2 pt1) (nth 2 pt2)))
      )
   )
(command "layer" "s" "4" "");放置层
(command "line" PT1 pt12  "")
(command "layer" "s" "0" "");放置层   
;(command "color" 255)
(command ".circle" pt12 bj)
(command "layer" "s" "cut" "")
(princ)
)

linheyuanpcb

defun c:ah()
(vl-load-com)
(command "undo" be)
(princ "/n请选取要加引线孔的槽孔 POLYLINE:")
(setq hy_ms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(setq ss (ssget '((0 . "*POLYLINE") (70 . 1) (90 . 4))));对POLYLINE图形有效
;(setq ss (ssget '((0 . "line") )))  ---这里是对线条有效,
(setq k 0)
;(command "pedit" "m" ss "" "y" "j" "" "")
(setq ent (entlast))
;(repeat (sslength ss)
;(setq ent (ssname ss k))
(vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint )
(setq maxpoint (vlax-safearray->list maxpoint)
minpoint (vlax-safearray->list minpoint)
maxpoint (trans maxpoint 0 1)
minpoint (trans minpoint 0 1)
mx (/ (+ (car maxpoint) (car minpoint)) 2.0)
my (/ (+ (cadr maxpoint) (cadr minpoint)) 2.0)
dx (/ (- (car maxpoint) (car minpoint)) 2.0)
dy (/ (- (cadr maxpoint) (cadr minpoint)) 2.0)
mpt (list mx my)
)
(cond
((> dx dy)(setq mpt1 (list mx (+ my dy))))
((< dx dy)(setq mpt1 (list (+ mx dx) my)))
)
(command "layer" "s" "4" "")
;(command "line" mpt mpt1 "")
(command "layer" "s" "0" "")
(command "circle" mpt "0.33")
(vla-addline hy_ms (vlax-3d-point (trans mpt 1 0)) (vlax-3d-point (trans mpt1 1 0)))
(setq k (1+ k))
;)
;(command "explode" ent)
(command "undo" e)
(command "layer" "s" "cut" "")
)

这只对一个新图形有效，有高手改动下，  如果两个图，只对一个有效，但另画一个新的就可以操作，