带记忆的连续复制，求助各位大侠帮忙完善下

--@----- · 发表于 2013-11-16 11:38:07

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

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

×

先发个原来的帖子求助，原帖子内容如下：此代码是连续复制：  可以输入距离，也可以点两点确定距离，方向上是鼠标拖动个方向就确定（无须点两点确定）。按下空格就继续复制下去。现有个问题是要在距离的问题上增加个默认上次连续复制的距离。也就是在输入距离这个时候我空格下就是默认的上次距离了（原，输入距离，和点两点确定距离还保留，当和上次距离不一样时就能用到了）  希望大家看看能解决不，在实际画图中，这个使用的频率还是很高的。代码如下    (defun c:fz( / an dis p p1 p2 s sa ss)
  (setq ss (ssget) p ""
      p1 (getpoint "\n起点：")
      p2 (getpoint "\n第二点:" p1)
      an (angle p1 p2) dis (distance p1 p2)
  )
  (setq s (entlast) sa (ssadd))
  (command "copy" ss "" p1 p2)
  (setq s (entnext s))
  (while s (ssadd s sa)(setq s (entnext s)))
  (while (= p "" )
(setq p (getstring "\n空格键继续：")
      p1 p2 p2 (polar p1 an dis)
      ss sa
)
(setq s (entlast) sa (ssadd))
(if p
   (command "copy" ss "" p1 p2)
)

(setq s (entnext s))
(while s (ssadd s sa)(setq s (entnext s)))
  )
  (princ)
)
下面的代码是可以实现记忆功能了，但是在确定距离的时候只能输入距离值，不能点击屏幕上的两点来确定距离值，有点遗憾，现在我想实现的是带记忆的可以输入距离值也可以点击屏幕上的两点来确定的连续复制功能（此点击两点既是方向，又是距离。避免点击两点确定方向，再点击两点确定距离的麻烦） (defun c:cc( / an dis p p1 p2 s sa ss m)
  (setq ss (ssget)
      p1 (getpoint "\n起点：")
      p2 (getpoint "\n第二点:" p1)
      an (angle p1 p2)
)
  (if (= nil dis_backup)
   (setq
      dis (distance p1 p2)
      dis_backup dis
)
(progn
(setq m (getstring "\n空格[上次距离]数字【新值】："))
(if (= "" m)
   (setq dis dis_backup);当按空格时选择上次距离

   ;-------------------------
   ;选择这次距离，并且备份
   (progn
   (setq dis (atof m)
         dis_backup dis
   )
  )
   ;-------------------------

)
)
  )

  (setq s (entlast)
sa (ssadd)
p2 (polar p1 an dis)
  )
  (command "copy" ss "" p1 p2)
  (setq s (entnext s))
  (while s (ssadd s sa)
      (setq s (entnext s))
)
  (setq p (getstring "\n空格键继续："))
  (while (= p "" )
(setq
      p1 p2
p2 (polar p1 an dis)
      ss sa
)
(setq s (entlast) sa (ssadd))
(if p
   (command "copy" ss "" p1 p2)
)

(setq s (entnext s))
(while s (ssadd s sa)(setq s (entnext s)))
(setq p (getstring "\n空格键继续："))
  )
  (princ)
)

--@----- · 发表于 2013-11-16 11:40:16

大家有时间的可以研究下下面发个这个功能相关的图片

newer · 发表于 2013-11-16 11:45:55

--@----- 发表于 2013-11-16 11:40
大家有时间的可以研究下下面发个这个功能相关的图片

对话框漂亮，用ODCL写的？

--@----- · 发表于 2013-11-16 12:02:28

我不会写，呵呵，这个是集天正,LSP,迷你做了一个图片的{:soso_e113:}

eachy · 发表于 2013-11-16 13:56:41

第二个getpoint改成getdist，接下来需要一个获取光标位置函数来确定方向
或者第二个getpoint配合initget，允许输入数值，同样需要一个获取当前光标位置函数

st788796 · 发表于 2013-11-16 21:31:50

一个小测试

(defun c:tt (/ p1 p2 p20)
(if (and (setq p1 (getpoint "\nBase Point: "))
(setq p2 (getdist p1 "\nSencond Point: "))
)
(progn
(setq p20 (cadr (grread t 15 0)))
(princ "\nDistance = ")
(princ p2)
(princ "\nSencond Point = ")
(princ p20)
(princ "\nDis = ")
(princ (distance p1 p20))
)
)
(princ)
)

--@----- · 发表于 2013-11-16 21:40:27

st788796 发表于 2013-11-16 21:31
一个小测试

不行啊这个是要加载晓东的工具吗？我的命令行出现的是英文，执行没反应。

st788796 · 发表于 2013-11-16 21:50:56

--@----- 发表于 2013-11-16 21:40
不行啊这个是要加载晓东的工具吗？我的命令行出现的是英文，执行没反应。

只是给你一个方法，既能输入距离也能获取方向，另外一个用 Getpoint 方法

(defun c:tt (/ p1 p2 dis)
(if (and (setq p1 (getpoint "\nBase Point: "))
(progn
(initget 128)
(setq p2 (getpoint p1 "\nSecond Point or Distance: "))
)
)
(progn
(if (= (type p2) 'STR)
(progn (setq dis p2
p2 (cadr (grread t 15 0))
)
(princ "\nYou Input = ")
(princ dis)
(princ "\nCursor Coord = ")
(princ p2)
(princ "\nAngle = ")
(princ (angle p1 p2))
)
(progn
(setq dis (distance p1 p2))
(princ "\nYour Pick Coord = ")
(princ p2)
(princ "\nDistance = ")
(princ dis)
(princ "\nAngle = ")
(princ (angle p1 p2))
)
)
)
)
(princ)
)

(defun c:tt (/ p1 p2 dis) 
  (if (and (setq p1 (getpoint "\nBase Point: ")) 
           (progn 
             (initget 128) 
             (setq p2 (getpoint p1 "\nSecond Point or Distance: ")) 
           ) 
      ) 
    (progn 
      (if (= (type p2) 'STR) 
        (progn (setq dis p2 
                     p2         (cadr (grread t 15 0)) 
               ) 
               (princ "\nYou Input = ") 
               (princ dis) 
               (princ "\nCursor Coord = ") 
               (princ p2) 
               (princ "\nAngle = ") 
               (princ (angle p1 p2)) 
        ) 
        (progn 
          (setq dis (distance p1 p2)) 
          (princ "\nYour Pick Coord = ") 
          (princ p2) 
          (princ "\nDistance = ") 
          (princ dis) 
          (princ "\nAngle = ") 
          (princ (angle p1 p2)) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

--@----- · 发表于 2013-11-16 21:57:47

st788796 发表于 2013-11-16 21:50
只是给你一个方法，既能输入距离也能获取方向，另外一个用 Getpoint 方法

嗯{:soso_e100:}

st788796 · 发表于 2013-11-16 21:57:59

--@----- 发表于 2013-11-16 21:40
不行啊这个是要加载晓东的工具吗？我的命令行出现的是英文，执行没反应。

改造 Getpoint p2

(defun c:cc (/ an dis p p1 p2 s sa ss m d)
(if (and
(setq ss (ssget)
p1 (getpoint "\n起点：")
)
(progn
(initget 128)
(setq p2 (getpoint "\n第二点<距离>:" p1))
(if (= (type p2) 'STR)
(setq d p2
p2 (grread t 15 0)
p2 (polar p1 (angle p1 p2) (distof d))
)
p2
)
)
)
(progn
(setq an (angle p1 p2))
(if (= nil dis_backup)
(setq
dis (distance p1 p2)
dis_backup dis
)
(progn
(setq m (getstring "\n空格[上次距离]数字【新值】："))
(if (= "" m)
(setq dis dis_backup) ;当按空格时选择上次距离
(progn
(setq dis (atof m)
dis_backup
dis
)
)
)
)
)
(setq s (entlast)
sa (ssadd)
p2 (polar p1 an dis)
)
(command "copy" ss "" p1 p2)
(setq s (entnext s))
(while s
(ssadd s sa)
(setq s (entnext s))
)
(setq p (getstring "\n空格键继续："))
(while (= p "")
(setq
p1 p2
p2 (polar p1 an dis)
ss sa
)
(setq s (entlast)
sa (ssadd)
)
(if p
(command "copy" ss "" p1 p2)
)
(setq s (entnext s))
(while s (ssadd s sa) (setq s (entnext s)))
(setq p (getstring "\n空格键继续："))
)
)
)
(princ)
)

(defun c:cc (/ an dis p p1 p2 s sa ss m d) 
  (if (and 
        (setq ss (ssget) 
              p1 (getpoint "\n起点：") 
        ) 
        (progn 
          (initget 128) 
          (setq p2 (getpoint "\n第二点<距离>:" p1)) 
          (if (= (type p2) 'STR) 
            (setq d  p2 
                  p2 (grread t 15 0) 
                  p2 (polar p1 (angle p1 p2) (distof d)) 
            ) 
            p2 
          ) 
        ) 
      ) 
    (progn 
      (setq an (angle p1 p2)) 
      (if (= nil dis_backup) 
        (setq 
          dis             (distance p1 p2) 
          dis_backup dis 
        ) 
        (progn 
          (setq m (getstring "\n空格[上次距离]数字【新值】：")) 
          (if (= "" m) 
            (setq dis dis_backup)        ;当按空格时选择上次距离 
            (progn 
              (setq dis        (atof m) 
                    dis_backup 
                     dis 
              ) 
            ) 
          ) 
        ) 
      ) 
      (setq s  (entlast) 
            sa (ssadd) 
            p2 (polar p1 an dis) 
      ) 
      (command "copy" ss "" p1 p2) 
      (setq s (entnext s)) 
      (while s 
        (ssadd s sa) 
        (setq s (entnext s)) 
      ) 
      (setq p (getstring "\n空格键继续：")) 
      (while (= p "") 
        (setq 
          p1 p2 
          p2 (polar p1 an dis) 
          ss sa 
        ) 
        (setq s         (entlast) 
              sa (ssadd) 
        ) 
        (if p 
          (command "copy" ss "" p1 p2) 
        ) 
        (setq s (entnext s)) 
        (while s (ssadd s sa) (setq s (entnext s))) 
        (setq p (getstring "\n空格键继续：")) 
      ) 
    ) 
  ) 
  (princ) 
)

--@----- · 发表于 2013-11-16 22:25:04

本帖最后由 --@----- 于 2013-11-16 22:51 编辑

st788796 发表于 2013-11-16 21:57
改造 Getpoint p2

感觉增加记忆功能的跟点击两点确定距离是有冲突的：也就是说我点击两点按下空格是默认上次距离值呢，还是以这两点的距离作为间距呢。所以用空格键判定不了。我现在想：点击两点按下空格是默认上次的;输入距离值是按输入距离值执行的;按左键是默认这两点的距离作为复制间距执行的;这只是个想法，避免了上述的冲突，还保留了功能的齐全！

friendship12c · 发表于 2014-4-11 15:11:35

研究一下，学习中...

账号		自动登录	找回密码
密码			立即注册

[求助] 带记忆的连续复制，求助各位大侠帮忙完善下

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

点评

点评

点评