求大师一个，曲线断开，分开 生成外轮廓
本帖最后由 世井 于 2025-2-22 17:03 编辑曲线断开，分开 生成外轮廓
(defun c:tt ( / ss obj p1 P9 ss1 n en pt1 pt2 SS2 ssaa s0 iidx SS3 idx ent1)
(setvar "CMDECHO" 0)
(command "_undo" "be")
(setq ss (ssget))
(SETQ obj (baoweihe SS))
(setq p1 (car obj));左下角点
(setq p9 (cadr obj));右上角点
(command "_copyclip" "non" p1 ss "");复制一个隐藏
(SETVAR 'PEDITACCEPT 1) ;转化为多段线
(COMMAND "_.pedit" "m" ss "" "j" 0 "")
(setq ss1 (ssget "w" p9 p1))
(repeat (setq n (sslength ss1))
(setq en(ssname ss1 (setq n (1- n)))
pt1 (vlax-curve-getstartpoint en)
pt2 (vlax-curve-getendpoint en)
)
(command "lengthen" "de" 2 "non" (list en pt1) "non" (list en pt2) "")
)
(setvar "QAFLAGS" 1)
(command "explode" ss1 "")
(setvar "QAFLAGS" 0)
(setq ss2 (ssget "p"))
(COMMAND "_.pedit" "m" ss2 "" "j" 0 "")
(setq ssaa (ssget "w" p9 p1 '((0 . "*POLYLINE,*LWPOLYLINE"))))
(setq s0 (ss->lst ssaa))
(mapcar '(lambda (x) (vla-Offset (Vlax-Ename->Vla-Object x) 15)) s0)
(repeat(setq iidx (sslength ssaa)) (entdel (ssname ssaa (setq iidx (1- iidx)))) )
(setq SS3 (ssget "C" p9 p1 '((0 . "*POLYLINE,*LWPOLYLINE"))))
(LM:outline SS3)
;(set ent1 (entlast))
(repeat(setq idx (sslength SS3))
(entdel (ssname SS3 (setq idx (1- idx)))) ) ;删除原来
;(vla-Offset (Vlax-Ename->Vla-Object ent1) -5)
;(entdel ent1)
(command "_pasteclip" "non" p1)
(command "_undo" "e")
(princ))
(defun ss->lst(ss);选择集转图元名列表
(vl-remove-if(function listp)(mapcar (function cadr) (ssnamex SS))))
(defun baoweihe (sel / idx llp ls1 ls2 obj urp) ;算出包围框
(repeat (setq idx (sslength sel))
(setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
(if
(and
(vlax-method-applicable-p obj 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp)))) )
(setq ls1 (cons (vlax-safearray->list llp) ls1)
ls2 (cons (vlax-safearray->list urp) ls2) ) ) )
(if (and ls1 ls2)
(mapcar '(lambda (a b) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2)) ))
(defun LM:outline ( sel / app are box cmd dis enl ent lst obj rtn tmp );创建外轮廓
(if (setq box (LM:ssboundingbox sel))
(progn
(setq app (vlax-get-acad-object)
dis (/ (apply 'distance box) 20.0)
lst (mapcar '(lambda ( a o ) (mapcar o a (list dis dis))) box '(- +))
are (apply '* (apply 'mapcar (cons '- (reverse lst))))
dis (* dis 1.5)
ent
(entmakex
(append
'( (000 . "LWPOLYLINE")
(100 . "AcDbEntity")
(100 . "AcDbPolyline")
(090 . 4)
(070 . 1)
)
(mapcar '(lambda ( x ) (cons 10 (mapcar '(lambda ( y ) ((eval y) lst)) x)))
'( (caar cadar)
(caadrcadar)
(caadr cadadr)
(caarcadadr)
) )) ))
(apply 'vlax-invoke
(vl-list* app 'zoomwindow
(mapcar '(lambda ( a o ) (mapcar o a (list dis dis 0.0))) box '(- +))) )
(setq cmd (getvar 'cmdecho)
enl (entlast)
rtn (ssadd) )
(while (setq tmp (entnext enl)) (setq enl tmp))
(setvar 'cmdecho 0)
(command"_.-boundary" "_a" "_b" "_n" sel ent "" "_i" "_y" "_o" "_p" "" "_non"
(trans (mapcar '- (car box) (list (/ dis 3.0) (/ dis 3.0))) 0 1) "")
(while (< 0 (getvar 'cmdactive)) (command ""))
(entdel ent)
(while (setq enl (entnext enl))
(if (and (vlax-property-available-p (setq obj (vlax-ename->vla-object enl)) 'area)
(equal (vla-get-area obj) are 1e-4) )
(entdel enl)
(ssaddenl rtn)
) )
(vla-zoomprevious app)
(setvar 'cmdecho cmd)
rtn
) ))
(defun LM:ssboundingbox ( s / a b i m n o )
(repeat (setq i (sslength s))
(if (and
(setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
(vlax-method-applicable-p o 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b)))) )
(setq m (cons (vlax-safearray->list a) m)
n (cons (vlax-safearray->list b) n) ) ) )
(if (and m n)
(mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n)) ))
我想这是明经币难以实现的一个大工程
好像是模具下料孔 本帖最后由 xyp1964 于 2025-2-19 20:09 编辑
本帖最后由 gzcsun 于 2025-2-19 22:24 编辑
自己做一个吧
gzcsun 发表于 2025-2-19 21:56
自己做一个吧
思路非常清晰 gzcsun 发表于 2025-2-19 21:56
自己做一个吧
gzcsun 发表于 2025-2-19 21:56
自己做一个吧
大师，为什么向外偏移15再向内偏移5呢，直接向外偏移10，不可以么 世井 发表于 2025-2-20 19:39
大师，为什么向外偏移15再向内偏移5呢，直接向外偏移10，不可以么
让CAD可以自动计算，外形更圆滑。
你试一下就知道。 世井 发表于 2025-2-20 19:39
大师，为什么向外偏移15再向内偏移5呢，直接向外偏移10，不可以么
直接外偏移10的效果
页:
[1]
2