明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2028|回复: 27

[提问] 如何增加带记忆的复制,空格确认上一步的距离

[复制链接]
发表于 2021-9-19 21:09 | 显示全部楼层 |阅读模式
2明经币
请教大神们,我下面的这个程序如何增加带记忆的复制呢,类似图片的这个效果的,默认效果是要重复不断的输入指定距离的,步骤有点多了,我想能空格确认上一次的距离那就方便多啦
(defun c:tt5(/ ent ss)
  (setq n1 10)
  (defun *error* (msg)
    (if ss (sshighlight ss 4)) ;取消亮显
    (SSSETFIRST NIL)
    (princ "error:")
    (princ msg)
  )

  (setq a (cadr (ssgetfirst)))
  (if a
    (setq ss a)
    (setq ss (ssget))
  )
  (setvar "cmdecho" 0)
  (command "undo" "g")
  ;;预选择函数段必须在这一句之前,否则无效
  (setq pt Nil)
  (if (< (sslength ss) n1)  (SSSETFIRST NIL SS))
   (sshighlight ss 3)
  (setq p1 (getpoint "指定基点: "))
  (princ "\n")
  (if p1
    (progn
      (while (not (equal p1 pt 1e-4))
(setq ent (entlast))
(setq pt p1)
(princ "指定下一点: ")
(vl-cmdf "copy" ss "" "non" pt pause)
(setq tempss ss)
(setq ss (entbackss ent))
(setq p1 (getvar "lastpoint"))
      )
      (command "._erase" ss "")
      (command "select" tempss "")
    )
    (princ "\n未指定基准点,程序结束\n")
  )
)

;控制选择集亮显
(defun sshighlight (ss n / slen i  ent )
  (setq slen (sslength ss) i 0 )
  (while (ssname ss i)
    (setq ent (ssname ss i))
    (redraw ent n);亮显
    (setq i (1+ i))
  )
  T
)
附件: 您需要 登录 才可以下载或查看,没有账号?注册

最佳答案

查看完整内容

修订了复制属性块出错 ;;; __________________________________________ ;;; 连续复制3.0 langjs 2021.12.17 ;;; 命令:fz 右键默认距离复制 esc键退出 ;;; __________________________________________ (defun c:fz (/ #err4 $orr d en p0 p1 r snap ss) (defun ssnext (en / ss) (setq ss (ssadd)) (while (setq en (entnext en)) (if (not (member (cdr (assoc 0 (entget en))) (lis ...
"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2021-9-19 21:09 | 显示全部楼层
本帖最后由 langjs 于 2021-12-17 11:58 编辑

修订了复制属性块出错
;;; __________________________________________
;;; 连续复制3.0     langjs         2021.12.17
;;; 命令:fz      右键默认距离复制  esc键退出
;;; __________________________________________
(defun c:fz (/ #err4 $orr d en p0 p1 r snap ss)
  (defun ssnext (en / ss)
    (setq ss (ssadd))
    (while (setq en (entnext en))
      (if (not (member (cdr (assoc 0 (entget en))) (list "ATTRIB" "VERTEX" "SEQEND")))
        (setq ss (ssadd en ss))
      )
    )
    ss
  )
  (defun #err4 (s)
    (command ".UNDO" "E")
    (setvar "osmode" snap)
    (setq *error* $orr)
  )
  (setq snap (getvar "osmode"))
  (setvar "cmdecho" 0)
  (setq $orr *error*
        *error* #err4
  )
  (if (setq ss (ssget))
    (if (setq p0 (getpoint "\n指定基点:"))
      (progn
        (while t
          (command ".UNDO" "BE")
          (princ "\n指定下一点或距离:")
          (if d
            (progn
              (setvar "osmode" 0)
              (princ (strcat "<" (rtos d) ">:"))
            )
          )
          (setq en (entlast))
          (command ".copy" ss "" p0 pause)
          (command ".erase" (ssnext en) "")
          (setq p1 (getvar "lastpoint"))
          (if (equal p0 p1 1e-8)
            (setq p1 (polar p0 r d))
            (setq d (distance p0 p1)
                  r (angle p0 p1)
            )
          )
          (if (not (equal p0 p1 1e-8))
            (progn
              (setq en (entlast))
              (command ".copy" ss "" p0 p1)
              (setq ss (ssnext en)
                    p0 p1
              )
            )
          )
          (command ".UNDO" "E")
        )
      )
    )
  )
  (setq *error* $orr)
  (princ)
)

评分

参与人数 1明经币 +1 收起 理由
magicheno + 1 很给力!

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2021-9-21 21:46 | 显示全部楼层
langjs 发表于 2021-9-19 21:09
;;; __________________________________________
;;; 连续复制2.0     langjs         2016.03.27
;;;  ...

狼大侠太给力了,这个折腾了好久,总算有一个完美的效果了
回复

使用道具 举报

 楼主| 发表于 2021-9-21 22:15 | 显示全部楼层
langjs 发表于 2021-9-19 21:09
;;; __________________________________________
;;; 连续复制2.0     langjs         2016.03.27
;;;  ...

狼大师,反馈几个问题哈 (equal p0 p1) 在USC下输入距离然后空格复制时会有问题的,改成这个(equal p0 p1 1e-8)貌似就可以了,不知道啥原因,还有就是涉及到属性块的单体,单独复制的属性块,就会显示未知命令,然后自动中断了,如果属性块在其他编组内部,编组功能打开的,或者在其他普通块的内部就没这个问题,不知道为什么,只要属性块单独存在的,一复制就会出错了

点评

时间久了,我也忘了思路了  发表于 2021-9-22 18:04
回复

使用道具 举报

发表于 2021-9-22 17:39 | 显示全部楼层
magicheno 发表于 2021-9-21 22:15
狼大师,反馈几个问题哈 (equal p0 p1) 在USC下输入距离然后空格复制时会有问题的,改成这个(equal p0 p1 ...

试了,我这也有这问题。
回复

使用道具 举报

 楼主| 发表于 2021-9-22 19:44 | 显示全部楼层
langjs 发表于 2021-9-19 21:09
;;; __________________________________________
;;; 连续复制2.0     langjs         2016.03.27
;;;  ...

狼大师,属性块出错影响挺大的额,每天都是跟属性块打交道的

点评

更新过程序了,试试  发表于 2021-12-17 11:59
回复

使用道具 举报

 楼主| 发表于 2021-9-23 12:42 | 显示全部楼层
langjs 发表于 2021-9-19 21:09
;有个新一点的版本
;;; __________________________________________
;;; 连续复制3.0     langjs        ...


狼大师,不知道为什么属性块还是不行呢,一复制就出问题的,不知道为啥呢

本帖子中包含更多资源

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

x
回复

使用道具 举报

发表于 2021-12-13 20:57 | 显示全部楼层
狼大侠的程序,好用!
回复

使用道具 举报

发表于 2021-12-17 12:00 | 显示全部楼层
magicheno 发表于 2021-9-23 12:42
狼大师,不知道为什么属性块还是不行呢,一复制就出问题的,不知道为啥呢

修订了一个新版本,解决属性块出错问题,你试试
回复

使用道具 举报

 楼主| 发表于 2021-12-17 14:11 | 显示全部楼层
langjs 发表于 2021-12-17 12:00
修订了一个新版本,解决属性块出错问题,你试试

感谢狼大师,试过了可以的,效果非常好
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-29 15:26 , Processed in 0.191326 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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