myflying帮帮我！

yudong716

myflying请帮帮我！我在明经通道上下载了一个程序：
;sline.lsp
; 产生一个两端带箭头的双点划折线，箭头和线宽可指定。

(defun c:sline ()
  (setvar "cmdecho" 0)
  (if (not asize) (setq asize 0.50))      ;初始化箭头尺寸
  (if (not PThk)  (setq PThk 0.030))      ;多义线宽度
  (defun GETR (val msg / tm)
    (setq tm (getreal (strcat msg " <" (rtos val 2 4) ">: ")))
    (cond ((= (type tm) 'REAL) (eval tm))
          ((= tm nil) (eval val))
          (t (princ "\007 *错误* 不是一个实数") (eval val)) ) )
  (defun loop ()
    (cond ((setq p2 (getpoint p1 "到点： ")) (command p2)
                                     (setq p0 p1) (setq p1 p2) (loop))
          ( t (command "u" (polar p1 (angle p1 p0) asize)
                       "w" (/ asize 3) 0.0 p1 ""))))
  (setq asize (getr asize "箭头大小"))
  (setq PThk  (getr PThk " 多义线宽度"))
  (setq p1 (getpoint " 从点： "))
  (command "pline" p1 "w" 0.0 0.0)
  (setq p2 (getpoint p1 " 到点： "))
  (command "w" 0.0 (/ asize 3) (polar p1 (angle p1 p2) asize)
           "w" PThk PThk p2)
  (setq p1 p2)
  (loop)
  ;(command "change" "l" "" "p" "lt" "phantom" "")
  (eval "完成")
)
(prompt "\n键入SLINE唤起命令： ")

能不能请你稍做改动将程序改为两端带箭头的直线，箭头和线宽可指定。（我还没入门）

meflying

这个程序好象就满足这个要求啊，不过在此处要加一句，
  (command "w" 0.0 (/ asize 3) (polar p1 (angle p1 p2) asize)
           "w" PThk PThk p2)
  (setq p0 p1) ;加此句
  (setq p1 p2)
  (loop)

而且getr loop p0 p1 p2 最好做局部变量处理，即第一行改为
(defun c:sline ( / GETR loop p0 p1 p2)

如果你不是这个意思，请再说清楚些

yudong716

我是这个意思，多谢meflying大哥。能不能再问一个小问题，如果再编一个程序，可以调用上述程序吗？就是本来我用直线画一个矩形，现在可以用SLINE代替LINE吗？麻烦您了！

meflying

可以，调用方法为：
(c:line)
画矩形只要将箭头大小设为0。
不过没必要这样，如果想画矩形可以用：
(command "pline")
效果同那个一模一样，还有矩形有专门的命令：rectangle
用LINE画的就同以上有所不同，不能设线宽（不过可以在层里设定），而且是四个单独的对象。

yudong716

我说的画矩形只是打个比方，实际要作的的是：原本填充直线的图形，我现在想用SLINE两端带箭头的直线替代，我们现在要做这样的产品，用(c:line)就可以了，是吧，就相当于在主程序中调用子程序吗？

meflying

不好意思，是(c:sline)

不过这样子你必须手动输入各点，不能靠计算得到的点来画。
你是想要它来画图，还是要这个东西作为填充的内容？

yudong716

我是要这个东西作为填充的内容，是不是有点麻烦。

meflying

难，画出箭头的直线和填充图案是两回事，如果用直线自己去画填充部分，找边界问题就比较困难了，填充图案中箭头的实心和线宽也很难实现

yudong716

谢谢meflying大哥的帮助，对了，能麻烦问一下meflying大哥，*.pat文件是怎样生成的，它里面有没有什么固定的要素，我这里有几个*.pat文件的LISP程序，看不懂。

meflying

这个文件就是文本文件，主要是定义一些填充图案，你可以用任何文本编辑器生成，存为*.pat就可以了。