[编程申请]：能否编一个小的LISPT程序

fjb_x

比如一条直线，我要在该直线两边各偏移0.35毫米并删除原直线.谢谢了.大家猴年快乐

badaguai

打击到盘

xyp1964

现编了个“单线变双线”的程序：
[php]
;;;单线改双线
(defun c:test042 (/ s1 e pt1 pt2 pt3 pt4 la)
  (load "xyp_lib")
  (CMDLA0)
  (setq        no1 (ureal 1 "" "\n\t双线宽" no1)
        s1  (entsel)
        e   (car s1)
        pt1 (dxf 10 (entget e))
        pt2 (dxf 11 (entget e))
        pt3 (_midpup pt1 pt2 0.35)
        pt4 (_midpdn pt1 pt2 0.35)
        la  (dxf 8 (entget e))
  )
  (command ".undo" "BE")
  (setvar "osmode" 0)
  (command "offset" (/ no1 2) s1 pt3 s1 pt4 "")
  (entdel e)
  (command ".undo" "E")
  (CMDLA1)
)
[/php]

fjb_x

谢谢青铜长老.但是我用了后出现错误,还得请你指教. 输入命令后有输入双线宽再选择线后出现NULL FUNCTION错误.

82406515

我也需要，但是也和4F的一样出现了错误，望改进。

xyp1964

2004上测试没有问题，把全部信息贴出来。

82406515

最初由 xyp1964 发布
[B]2004上测试没有问题，把全部信息贴出来。 [/B]

我用的是R14的。长老我问你，你编的那个（线开口增强版1）是不是真得没办法加到R14里去啊

xyp1964

修改后见3楼。

82406515

长老我还有一事相求，就是自动加边匡的程序，你看一下我传上来的文件就知道了。要求就是要能按我想的输入离图形边多少就多少，不知道长老可否帮我这个忙。

xyp1964

[php]
;;;加边框
(defun c:test ()
  (setq        no1 (ureal 1 "" "\n\t边框宽" no1)
        pt1 (getpoint "\n左下角 : ")
        pt2 (getcorner pt1 "\n右上角 : ")
        pt3 (list (- (car pt1) no1) (- (cadr pt1) no1))
        pt4 (list (+ (car pt2) no1) (+ (cadr pt2) no1))
  )
  (command "RECTANG" pt3 pt4)
  (princ)
)

(defun ureal (bit kwd msg def / inp)
  (if def
    (setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")
          bit (* 2 (fix (/ bit 2)))
    )
    (setq msg (strcat "\n" msg ": "))
  )
  (initget bit kwd)
  (setq inp (getreal msg))
  (if inp
    inp
    def
  )
)
[/php]

82406515

有点不对哟，我是想让它第一步，输命令，第二步就应该询问距离图形边多宽，第三步，我就输入我要的宽度，第四步，它就能够自动检测到图形的四边，然后按我的要求加出一个边匡。
还望长老在改进一下。

fjb_x

OK!可以了.谢谢长老.

82406515

还又啊，长老我可不可以把你帮我编的那个（线开口的软件）传上来，让其他高手帮忙改一下，好能够加到R14里去，不知道你有没有意见啊。

fjb_x

爱心币不够,不能与你悄悄交谈.长老啊,又有麻烦了.变成双线那程序有点问题,变双线后把该图层都变成红色的了.如果我只要把该双线为红色呢?图层其它的线型属性不变.

xyp1964

82406515：
加边框程序应该能满足使用要求，只不过比期望的要多两步。
另：你的信箱已满，无法发送短信。

fjb_x：
对于偏移程序的问题，将原程序中的(mkla la 1)去掉即可。