《分享》冲模模具设计实用的绘图命令（搭配统赢外挂使用）
本帖最后由 BEYOND10 于 2025-1-17 10:30 编辑首先声明，所有的快捷命令并不是本人所写。这些编程大神真的是很牛啊！！！这是我之前花了很长时间在论坛、QQ上搜寻的，还有一小部分是同事自己写的
本帖最后由 BEYOND10 于 2025-10-20 08:18 编辑
更新了几个功能.折弯R放回弹、零件自动坐标标注
感谢楼主分享 不错的插件 谢谢分享！！！！！ 已更新
快速侧视图的源码可以分享下吗 03hai 发表于 2024-5-5 10:07
快速侧视图的源码可以分享下吗
(defun c:CB (/ pt1 pt2 pt3 pt4 Y1 Y2 midY
lineYnewY1newY2X1 X2 midX lineXnewX1
newX2newpt1 newpt2 newpt3 newpt4 maxy miny minx maxx lls llss PDDXY PDDX PDDY
)
(setvar "cmdecho" 0)
(command "undo" "be")
(if (null PARTW)(setq PARTW 80))
(setq LLS PARTW)
(setq LLS (getdist (strcat "\n请输入零件厚度:<" (RTOS LLS) ">")))
(if (not lls)(setq lls PARTW))
(setq PARTW LLS)
(setq DIMDD 20)
(C:GETBOXCB)
(if (= des-GetBox-OK 1)
(progn
(setq pt1 des-GetBox-top-pt1)
(setq pt2 des-GetBox-bottom-pt2)
(setq pt3 des-GetBox-left-pt3)
(setq pt4 des-GetBox-right-pt4)
(setq maxy (cadr pt1))
(setq miny (cadr pt2))
(setq minx (car pt3))
(setq maxx (car pt4))
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq oldcolor (getvar "CECOLOR"))
(setvar "CECOLOR" "2")
(princ (strcat "\n***************************************
*****当前厚度:" (rtos PARTW) "mm,距离:" (rtos DIMDD) "mm****"))
(SETQ PDDXY (GETPOINT "\n选择方向点:(下侧或右侧,点右下侧同时绘制两个方向) ")
PDDX(CAR PDDXY)
PDDY(CADR PDDXY))
(if (> PDDX MAXX) (progn (dimmX)))
(if (< PDDY MINY)(progn (dimmY)))
(setvar "osmode" os)
(command "undo" "e")
)
(Princ "\n------无对象?!")
)
(Princ "\n-----------侧视图已经绘制，------------")
(prin1)
)
(defun dimmX()
(setq newpt1 (list (+ maxx DIMDD) maxy)) ;X向侧视图的左上角
(setq newpt2 (list (+ (+ maxx DIMDD) PARTW) MINY));X向侧视图的右下角
(setq newpt3 (list (+ maxx DIMDD)MinY)) ;X向侧视图的左下角
(setq newpt4 (list (+ (+ maxx DIMDD) (/ PARTW 2)) (- MINY 6)));坐标放置位置
(command "RECTANGLE" newpt1 newpt2)
(setvar "CECOLOR" oldcolor)
(command "dimlinear" newpt2 newpt3newpt4))
(defun dimmY()
(setq newpt1 (list minx (- miny DIMDD))) ;y向侧视图的左上角
(setq newpt2 (list maxx (- miny (+ DIMDD PARTW)))) ;y向侧视图的右下角
(setq newpt3 (list maxx (- miny DIMDD))) ;y向侧视图的右上角
(setq newpt4 (list (+ maxx 6) (- miny (+ DIMDD (/ PARTW 2)))));坐标放置位置
(command "RECTANGLE" newpt1 newpt2)
(setvar "CECOLOR" oldcolor)
(command "dimlinear" newpt2 newpt3newpt4))
(defun c:GetBoxCB (/ des-GetBox-en1 ename-name
vlaobject-ename-name
)
(setq des-GetBox-en1 nil)
(setq des-GetBox-OK nil)
(setq des-GetBox-en1 (entsel "\n选取零件外形(复线)... "))
(vl-load-com)
(while des-GetBox-en1
;;;当en1存在时，做以下内容，直到en1不存在为止
(sub-GetBoundingBox des-GetBox-en1)
(setq des-GetBox-en1 nil)
)
(prin1)
)
(defun sub-GetBoundingBox (des-GetBox-en1)
;;;(command "ucs" "w")
(setq ename-name (car des-GetBox-en1))
(setq vlaobject-ename-name
(vlax-ename->vla-object ename-name)
)
(vla-GetBoundingBox
vlaobject-ename-name
'minpoint
'maxpoint
)
(setq minpoint (vlax-safearray->list minpoint))
(setq maxpoint (vlax-safearray->list maxpoint))
(setq minpoint(trans minpoint 0 1)) ;转为ucs点
(setq maxpoint(trans maxpoint 0 1)) ;转为ucs点
(setq des-GetBox-top-pt1 maxpoint)
(setq des-GetBox-bottom-pt2 minpoint)
(setq des-GetBox-left-pt3 minpoint)
(setq des-GetBox-right-pt4 maxpoint)
(setq des-GetBox-midpt (polar minpoint
(angle minpoint maxpoint)
(/(distance minpoint maxpoint) 2.0)
))
(setq des-GetBox-OK 1)
(princ "\nReturn-BoundingBox-ok")
) BEYOND10 发表于 2024-5-15 15:34
(defun c:CB (/ pt1 pt2 pt3 pt4 Y1 Y2 midY
...
感谢分享,666
页:
[1]