批量动态单偏（过程中支持：改间距-换色-正交-扑捉）
本帖最后由 尘缘一生 于 2023-12-6 01:06 编辑修改自:高飞代码，
;;实体单向动态偏移---(一级)-----
;enam 实体名 dd 偏移距离
;修改自高飞源码
;三领集成 MODFY 尘缘一生 QQ 15290049
(defun ddenofdis (enam dd / loop bb obj objlst objs parper p0 n space space1 tp curpnt perpnt f3 f8)
(princ
(slmsg
"\n->移动偏移实体[改间距(TAB)/换色(C)/正交(F8)/扑捉(F3)](其余键-->定位确定)"
"\n->簿笆熬簿龟砰[э丁禯(TAB)/传︹(C)/タユ(F8)/汲(F3)](ㄤ龄-->﹚絋﹚)"
"\n->Move offset entity (other keys-->locate to determine)"
)
)
(setq obj (en2obj enam) tp (dxf1 enam 0) loop t objs nil f8 (getvar "ORTHOMODE") f3 (getvar "OSMODE"))
(while loop
(setq bb (grread t 15 2))
(setq p0 (cadr bb))
(cond
((equal bb '(2 6));F3切换捕捉开关
(cond
((and (< f3 16384) (/= f3 0))
(setq f3 (+ f3 16384))
(prompt (slmsg "\n <对象捕捉 关>" "\n <癸禜 闽>" "\n <OSnap Off>"))
)
((or (= f3 0) (>= f3 16384))
(setq f3 16383)
(prompt (slmsg "\n <对象捕捉 开>" "\n <癸禜 秨>" "\n <OSnap On>"))
)
)
(setvar "OSMODE" f3) (redraw)
)
((equal bb '(2 15)) ;F8切换正交开关
(if (= f8 0)
(progn (setq f8 1) (prompt (slmsg "\n <正交 开>" "\n <タユ 秨>" "\n <Orth open>")))
(progn (setq f8 0) (prompt (slmsg "\n <正交 关>" "\n <タユ 闽>" "\n <Orth off>")))
)
(setvar "ORTHOMODE" f8) (redraw)
)
((= (car bb) 5)
(and objs (mapcar 'vla-erase objs))
(setq objs nil curpnt (trans p0 1 0))
(setq perpnt (vlax-curve-getclosestpointto enam curpnt T))
(if (setq parper (vlax-curve-getParamAtPoint enam perpnt))
(progn
(if (> (det perpnt (mapcar '+ (vlax-curve-getFirstDeriv enam parper) perpnt) curpnt) 0)
(setq space1 (- dd))
(setq space1 dd)
)
(if (or (= tp "LINE") (= tp "XLINE"))
(setq space1 (- space1))
)
(setq space space1)
(repeat (fix (/ (distance perpnt curpnt) (abs space)))
(setq objlst (vl-catch-all-apply 'vla-offset (list obj space)))
(setq space (+ space space1))
(if (not (vl-catch-all-error-p objlst))
(progn
(setq objlst (vlax-safearray->list (vlax-variant-value objlst)))
(setq objs (append objlst objs))
)
)
)
)
)
)
((member bb '((2 9))) ;;table 键
(sldis (slmsg "偏移新间距:?" "熬簿穝丁禯:?" "Offset New Spacing") (slmsg "间距=" "丁禯=" "Spacing=") "0" "12")
(setq dd sldis1 enam (entlast) obj (en2obj enam) objs nil)
)
((member bb '((2 67) (2 99))) ;;C c 换色
(repeat (setq n (length objs))
(vla-put-color (nth (setq n (1- n)) objs) (atoi (slsjqs)))
)
(setq enam (entlast) obj (en2obj enam) objs nil)
)
((or t (member (car bb) '(11 25)) (member bb '((2 13))) (= (car bb) 3));;右键 右键 回车
(setq loop nil)
)
)
)
(princ)
)
更新23,12,5
三领的世界：
链接：https://pan.baidu.com/s/1jnD-HBTYYXlMXMSLdJnGBg
提取码：2tin
命令是啥？ 看起来真不错，感谢分享 出现 参数太少？？？？ 本帖最后由 mashanjie 于 2023-12-1 21:02 编辑
捧个人场 加载后如何使用呢？能自定义一个简单点的快捷命令吗？ 三领加这个还是很有必要的，很好用 本帖最后由 尘缘一生 于 2023-12-5 23:55 编辑
改写：丢弃正交，没作用
完美再现：单根快速
[*]
[*];;实体单向动态偏移---(一级)-----
[*];enam 实体名 dd 偏移距离
[*];三领集成 MODFY 尘缘一生 QQ 15290049
[*](defun ddenofdis (enam dd / loop bb obj objlst objs parper p0 p1 p2 n space space1 tp curpnt perpnt f3)
[*](princ
[*] (slmsg
[*] "\n->偏移实体[连增(`~)/增一(TAB)/改间距(Space bar)/换色(C)/扑捉(F3)](左右键...->定位确定)"
[*] "\n->熬簿龟砰[硈糤(`~)/糤(TAB)/э丁禯(Space bar)/传︹(C)/汲(F3)](オ龄...->﹚絋﹚)"
[*] "\n->Offset entity (Left-Right-Other keys-->locate to determine)"
[*] )
[*])
[*](setq obj (en2obj enam) tp (dxf1 enam 0) p1 (cadr (grread 5)) loop t objs nil f3 (getvar "OSMODE"))
[*](while loop
[*] (setq bb (grread t 8 1) p0 (cadr bb))
[*] (cond
[*] ((equal bb '(2 6));F3切换捕捉开关
[*] (cond
[*] ((and (< f3 16384) (/= f3 0))
[*] (setq f3 (+ f3 16384))
[*] (prompt (slmsg "\n <对象捕捉 关>" "\n <癸禜 闽>" "\n <OSnap Off>"))
[*] )
[*] ((or (= f3 0) (>= f3 16384))
[*] (setq f3 16383)
[*] (prompt (slmsg "\n <对象捕捉 开>" "\n <癸禜 秨>" "\n <OSnap On>"))
[*] )
[*] )
[*] (setvar "OSMODE" f3) (redraw)
[*] )
[*] ((= (car bb) 5)
[*] (redraw)
[*] (if (and (<= f3 16384) (> f3 0) (/= f8 1))
[*] (setq p0 (slosnappt nil p0))
[*] )
[*] (if objs (mapcar 'vla-erase objs))
[*] (setq objs nil curpnt (trans p0 1 0))
[*] (setq perpnt (vlax-curve-getclosestpointto enam curpnt T))
[*] (if (setq parper (vlax-curve-getParamAtPoint enam perpnt))
[*] (progn
[*] (if (> (det perpnt (mapcar '+ (vlax-curve-getFirstDeriv enam parper) perpnt) curpnt) 0)
[*] (setq space1 (- dd))
[*] (setq space1 dd)
[*] )
[*] (if (or (= tp "LINE") (= tp "XLINE"))
[*] (setq space1 (- space1))
[*] )
[*] (setq space space1)
[*] (repeat (fix (/ (distance perpnt curpnt) (abs space)))
[*] (setq objlst (vl-catch-all-apply 'vla-offset (list obj space)))
[*] (setq space (+ space space1))
[*] (if (null (vl-catch-all-error-p objlst)) ;无错
[*] (progn
[*] (setq objlst (vlax-safearray->list (vlax-variant-value objlst)))
[*] (setq objs (append objlst objs))
[*] )
[*] )
[*] )
[*] )
[*] )
[*] (grdraw p1 p0 3 2)
[*] )
[*] ((member bb '((2 9))) ;;table 键 +1
[*] (redraw)
[*] (if objs (mapcar 'vla-erase objs))
[*] (vl-catch-all-apply 'vla-offset (list obj space1))
[*] (setq enam (entlast) obj (en2obj enam) loop nil)
[*] )
[*] ((member bb '((2 96) (2 126))) ;`~键
[*] (redraw)
[*] (setq p1 (cadr (grread 5)))
[*] (vl-catch-all-apply 'vla-offset (list obj space1))
[*] (setq enam (entlast) obj (en2obj enam))
[*] )
[*] ((or
[*] (equal bb '(2 32));空格,换距离
[*] (member bb '((2 115) (2 83)));;S s
[*] )
[*] (sldis (slmsg "偏移新间距:?" "熬簿穝丁禯:?" "Offset New Spacing") (slmsg "间距=" "丁禯=" "Spacing=") "0" "12")
[*] (setq dd sldis1 enam (entlast) obj (en2obj enam) objs nil)
[*] )
[*] ((member bb '((2 67) (2 99))) ;;C c 换色
[*] (repeat (setq n (length objs))
[*] (vla-put-color (nth (setq n (1- n)) objs) (atoi (slsjqs)))
[*] )
[*] (setq enam (entlast) obj (en2obj enam) objs nil)
[*] )
[*] ((or t (member (car bb) '(11 25)) (member bb '((2 13))) (= (car bb) 3)) ;右键 回车 左键
[*] (setq loop nil)
[*] )
[*] )
[*])
[*](redraw)
[*](princ)
[*])
看起来效果很炫酷，不知道应用场景。 用在下料方面也不错~预留余量~
页:
[1]