设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 批量动态单偏（过程中支持：改间距-换色-正交-扑捉）
返回列表 发新帖
查看: 1315|回复: 9

[函数] 批量动态单偏（过程中支持：改间距-换色-正交-扑捉）

  [复制链接]
尘缘一生
发表于 2023-12-1 03:05:54 | 显示全部楼层 |阅读模式
本帖最后由 尘缘一生 于 2023-12-6 01:06 编辑

修改自:高飞代码，


  2. ;;实体单向动态偏移---(一级)-----
  3. ;enam 实体名 dd 偏移距离
  4. ;修改自高飞源码
  5. ;三领集成 MODFY 尘缘一生 QQ 15290049
  6. (defun ddenofdis (enam dd / loop bb obj objlst objs parper p0 n space space1 tp curpnt perpnt f3 f8)
  7.   (princ
  8.     (slmsg
  9.       "\n->移动偏移实体[改间距(TAB)/换色(C)/正交(F8)/扑捉(F3)](其余键-->定位确定)"
  10.       "\n->簿笆熬簿龟砰[э丁禯(TAB)/传︹(C)/タユ(F8)/汲(F3)](ㄤ龄-->﹚絋﹚)"
  11.       "\n->Move offset entity [Change Spacing(TAB)/Color Change(C)/Orth(F8)/Osnap (F3)] (other keys-->locate to determine)"
  12.     )
  13.   )
  14.   (setq obj (en2obj enam) tp (dxf1 enam 0) loop t objs nil f8 (getvar "ORTHOMODE") f3 (getvar "OSMODE"))
  15.   (while loop
  16.     (setq bb (grread t 15 2))
  17.     (setq p0 (cadr bb))
  18.     (cond
  19.       ((equal bb '(2 6));F3切换捕捉开关
  20.         (cond
  21.           ((and (< f3 16384) (/= f3 0))
  22.             (setq f3 (+ f3 16384))
  23.             (prompt (slmsg "\n <对象捕捉 关>" "\n <癸禜 闽>" "\n <OSnap Off>"))
  24.           )
  25.           ((or (= f3 0) (>= f3 16384))
  26.             (setq f3 16383)
  27.             (prompt (slmsg "\n <对象捕捉 开>" "\n <癸禜 秨>" "\n <OSnap On>"))
  28.           )
  29.         )
  30.         (setvar "OSMODE" f3) (redraw)
  31.       )   
  32.       ((equal bb '(2 15))    ;F8切换正交开关
  33.         (if (= f8 0)
  34.           (progn (setq f8 1) (prompt (slmsg "\n <正交 开>" "\n <タユ 秨>" "\n <Orth open>")))
  35.           (progn (setq f8 0) (prompt (slmsg "\n <正交 关>" "\n <タユ 闽>" "\n <Orth off>")))
  36.         )
  37.         (setvar "ORTHOMODE" f8) (redraw)
  38.       )
  39.       ((= (car bb) 5)
  40.         (and objs (mapcar 'vla-erase objs))
  41.         (setq objs nil curpnt (trans p0 1 0))
  42.         (setq perpnt (vlax-curve-getclosestpointto enam curpnt T))
  43.         (if (setq parper (vlax-curve-getParamAtPoint enam perpnt))
  44.           (progn
  45.             (if (> (det perpnt (mapcar '+ (vlax-curve-getFirstDeriv enam parper) perpnt) curpnt) 0)
  46.               (setq space1 (- dd))
  47.               (setq space1 dd)
  48.             )
  49.             (if (or (= tp "LINE") (= tp "XLINE"))
  50.               (setq space1 (- space1))
  51.             )
  52.             (setq space space1)
  53.             (repeat (fix (/ (distance perpnt curpnt) (abs space)))
  54.               (setq objlst (vl-catch-all-apply 'vla-offset (list obj space)))
  55.               (setq space (+ space space1))
  56.               (if (not (vl-catch-all-error-p objlst))
  57.                 (progn
  58.                   (setq objlst (vlax-safearray->list (vlax-variant-value objlst)))
  59.                   (setq objs (append objlst objs))
  60.                 )
  61.               )
  62.             )
  63.           )
  64.         )
  65.       )
  66.       ((member bb '((2 9))) ;;table 键
  67.         (sldis (slmsg "偏移新间距:?" "熬簿穝丁禯:?" "Offset New Spacing") (slmsg "间距=" "丁禯=" "Spacing=") "0" "12")
  68.         (setq dd sldis1 enam (entlast) obj (en2obj enam) objs nil)
  69.       )
  70.       ((member bb '((2 67) (2 99)))   ;;C c 换色
  71.         (repeat (setq n (length objs))
  72.           (vla-put-color (nth (setq n (1- n)) objs) (atoi (slsjqs)))
  73.         )
  74.         (setq enam (entlast) obj (en2obj enam) objs nil)
  75.       )
  76.       ((or t (member (car bb) '(11 25)) (member bb '((2 13))) (= (car bb) 3));;右键 右键 回车
  77.         (setq loop nil)
  78.       )
  79.     )
  80.   )
  81.   (princ)
  82. )
更新23,12,5




三领的世界：
链接：https://pan.baidu.com/s/1jnD-HBTYYXlMXMSLdJnGBg
提取码：2tin



本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
"觉得好，就打赏"
打赏
还没有人打赏，支持一下
回复

使用道具 举报

paulpipi
发表于 2023-12-1 07:54:00 | 显示全部楼层
看起来真不错，感谢分享
回复 支持 反对

使用道具 举报

bai2000
发表于 2023-12-1 09:32:13 | 显示全部楼层
出现 参数太少？？？？
回复 支持 反对

使用道具 举报

mashanjie
发表于 2023-12-1 21:02:19 | 显示全部楼层
加载后如何使用呢？能自定义一个简单点的快捷命令吗？
回复 支持 反对

使用道具 举报

zilong136
发表于 2023-12-2 04:27:51 | 显示全部楼层
三领加这个还是很有必要的，很好用
回复 支持 反对

使用道具 举报

尘缘一生
 楼主| 发表于 2023-12-5 23:38:47 | 显示全部楼层
本帖最后由 尘缘一生 于 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 [Continuous Add(`~)/Add One(TAB)/Change Spacing(Space Bar)/Color Change(C)/Osnap (F3)](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)
    • )
回复 支持 反对

使用道具 举报

Bao_lai
发表于 2023-12-7 19:25:55 来自手机 | 显示全部楼层
看起来效果很炫酷，不知道应用场景。
回复 支持 反对

使用道具 举报

zhangrunze
发表于 2024-3-13 11:57:08 | 显示全部楼层
用在下料方面也不错~预留余量~
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-11-25 22:50 , Processed in 0.208972 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表