[LISP程序]：求平均距离复制的工具

linsw

求在一段距离内按一个不大于多少数值来平均复制的工具，以下工具是可以，但用起来麻烦，因为在重复用时也要重复的输入m和数值，太烦琐了，希望用起来要简单，省掉输入m，数值是一个固定数值（如148），如果要换别的数值，我可以打开lisp程序修改的。

程序如下：
(defun C:CM ()
(setq A nil)
(setq OM (getvar "OSMODE"))
(setvar "OSMODE" 33)
(setq PNT1 (getpoint "\n拷贝路径起点： "))
(setq PNT2 (getpoint "\n拷贝路径终点： " PNT1))(terpri)
(initget 1 "M E N")
(prompt "\n选择如下之一： ")
(setq CTYPE
(getkword "\n(M)最大间距 (E)精确间距 (N)数量： "))
(if (= CTYPE "M")
(setq SP (getdist "\n最大对象间距:  ")))
(if (= CTYPE "E")
(setq SP (getdist "\n精确对象间距： ")))
(if (= CTYPE "N")
(setq SP (getreal "\n对象数量： ")))
(setq DIST (distance PNT1 PNT2))
(setq ANG (angle PNT1 PNT2))
(setq TEMP1 (/ DIST SP))
(setq TEMP2 (fix (/ DIST SP)))
(setq INC1 SP)
(setq INC2 (/ DIST (+ 1 (fix (/ DIST SP)))))
(setq INC3 (/ DIST (- SP 1)))
(if (= TEMP1 TEMP2) (setq INC INC1) (setq INC INC2))
(if (= CTYPE "E") (setq INC INC1) (setq INC INC))
(if (= CTYPE "N") (setq INC INC3) (setq INC INC))
(setq TMS (FIX (+ 0.00001 (/ DIST INC))))
(setvar "OSMODE" 0)
(setq A (ssget))
(setq INCR 0)
(repeat TMS
(setq INCR (+ INCR INC))
(setq NEWPT (polar PNT1 ANG INCR))
(command "copy" A "" PNT1 NEWPT)
)

恳请哪位朋友帮我编写一个，或对以上程序做点修改以达到以上要求(因本小弟我不会lisp,现在有很多的栏杆图之类的要画，用以上工具是很好用，但还是很麻烦，一天要重复的输入m和一个固定数值n多次)

gysjy

将
(if (= CTYPE "M")
(setq SP (getdist "\n最大对象间距: ")))
改为
(if (= CTYPE "M")(setq SP 148))

或者可采用下列连续复制程序：
[PHP]
(defun c:ccf( / an dis p p1 p2 s sa ss)
  (setq ss (ssget) p t
        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 (getpoint "\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)
)
[/PHP]

linsw

二楼的朋友：感谢你的回复，可是还是要输入Ｍ，能不也省了这步呢．因为最近画的图要用这个工具的重复太多了．
（另外，上面的左键复制好象就是小弟我找你做的吧，当时要求的是空键进行复制的，现也还在用，真的很好用的，特别是画楼梯时，谢谢哦)

gysjy

如果你不需要精确间距和对象数量的功能，可将
(initget 1 "M E N")
(prompt "\n选择如下之一： ")
(setq CTYPE
(getkword "\n(M)最大间距 (E)精确间距 (N)数量： "))
(if (= CTYPE "M")
(setq SP (getdist "\n最大对象间距: ")))
(if (= CTYPE "E")
(setq SP (getdist "\n精确对象间距： ")))
(if (= CTYPE "N")
(setq SP (getreal "\n对象数量： ")))
全部去掉，替换为(setq sp 148)。

linsw

谢谢，正是要这样的，我要画的栏杆有3种规格，这样就可以设好3个不同数值的3个命令，用起来方便多了。
非常感谢

另外,再问一下,能否在程序里实现在路径里的两端的单元不要(或去掉),象divide那样的两端不布置.
(附图中绿色部分的两端的两根立杆不要)

mygaga

不错啊 ````````````

paladi

不知道附件的多重偏移可不可以满足楼主的要求啊，可以连续偏移，有点像阵列。

gysjy

最初由 linsw 发布
[B]
另外,再问一下,能否在程序里实现在路径里的两端的单元不要(或去掉),象divide那样的两端不布置.
(... [/B]

将
(repeat TMS
(setq INCR (+ INCR INC))
(setq NEWPT (polar PNT1 ANG INCR))
(command "copy" A "" PNT1 NEWPT)
改为:
(repeat  (1- TMS)
(setq INCR (+ INCR INC))
(setq NEWPT (polar PNT1 ANG INCR))
(command "copy" A "" PNT1 NEWPT)
(command "erase" A "")
试试。

ljttjl

连续复制程序演示如下：

linsw

回ljttjl,paladi,我想做的是见下图,所以不能用等距离复制

因为栏杆的间距不一样，只要主立杆的时候不大于多少就可以了，但要平均好看，

linsw

gysjy,你好，谢谢你的回复，我照你的办法改了，但是不行呀，本想去掉两端的两个单元的，但是做完就剩下一个单元了，再把你命令的最后一行去掉，这样最后一个单元就没出来，这样差不多可以了，就是第一个单元我再手动删除了。如果还有好的办法望多多指教

gysjy

(repeat (1- TMS)
(setq INCR (+ INCR INC))
(setq NEWPT (polar PNT1 ANG INCR))
(command "copy" A "" PNT1 NEWPT)
(command "erase" A "")
的最后一行位置放错了。应为：
(repeat (1- TMS)
(setq INCR (+ INCR INC))
(setq NEWPT (polar PNT1 ANG INCR))
(command "copy" A "" PNT1 NEWPT)
）
(command "erase" A "")
现将你的程序修改如下，其中去除了绘制过程中的标识点；并且程序执行后，如果执行“u”命令，可以一步回退到位：
[PHP](defun C:CM ( / a ang bl dist inc inc1 inc2 inc3 incr newpt om pnt1 pnt2 sp temp1 temp2 tms)
  (command "undo" "g")
  (setq A nil)
  (setq OM (getvar "OSMODE") bl (getvar "blipmode"))
  (setvar "OSMODE" 33)
  (setvar "blipmode" 0)
  (setq PNT1 (getpoint "\n拷贝路径起点： ")
        PNT2 (getpoint "\n拷贝路径终点： " PNT1)
        sp 148 DIST (distance PNT1 PNT2)
        ANG (angle PNT1 PNT2)
        TEMP1 (/ DIST SP)
        TEMP2 (fix (/ DIST SP)) INC1 SP
        INC2 (/ DIST (+ 1 (fix (/ DIST SP))))
        INC3 (/ DIST (- SP 1))
  )
  (if (= TEMP1 TEMP2) (setq INC INC1) (setq INC INC2))
  (setq TMS (FIX (+ 0.00001 (/ DIST INC))))
  (setvar "OSMODE" 0)
  (setq A (ssget))
  (setq INCR 0)
  (repeat (1- TMS)
    (setq INCR (+ INCR INC))
    (setq NEWPT (polar PNT1 ANG INCR))
    (command "copy" A "" PNT1 NEWPT)
  )
  (command "erase" A "")
  (setvar "OSMODE" om)
  (setvar "blipmode" bl)
  (command "undo" "e")
  (princ)
)

[/PHP]

linsw

再次非常感谢gysjy，这样完全满足我的使用需要了，这样对我现在的工作量至少轻松了60%