[编程申请]：能帮我编一个打缺口的软件吗

82406515

*-*6 我想画一条线比如说：a长50 ，我想在上面打几个缺口，希望能象阵列一样输入 打几个缺口 每一个多大一下就出来了，我现在用的是最原始的 在上面画一条线然后在复制几毫米又剪掉它，好麻烦啊

xgwl

有必要吗?  用虚线的线型不就行了吗?象你这样, 图上有那么多的小短线,你觉得舒服吗?修改起来也不方便!

xyp1964

试试这个，直接画线，可能更简单：
[php]
;;;缺口线－虚线
(defun c:test036 ()
  (setq        dist1 (udist 1 "" "\n\t线长" dist1 (list 0 0))
        dist2 (udist 1 "" "\n\t缺口长" dist2 (list 0 0))
        pt1   (getpoint "\n\t起点")
        pt2   (getpoint pt1 "\n\t终点")
        ang   (angle pt1 pt2)
        n1    (fix (/ (distance pt1 pt2) (+ dist1 dist2)))
  )
  (repeat (fix n1)
    (setq pt2 (polar pt1 ang dist1)
          pt3 (polar pt2 ang dist2)
    )
    (command "line" pt1 pt2 "")
    (setq pt1 pt3)
  )
  (princ)
)
(defun udist (bit kwd msg def bpt / inp)
  (if def
    (setq msg (strcat "\n" msg "<" (rtos def) ">:")
          bit (* 2 (fix (/ bit 2)))
    )
    (setq msg (strcat "\n" msg ":"))
  )
  (initget bit kwd)
  (setq        inp
         (if bpt
           (getdist msg bpt)
           (getdist msg)
         )
  )
  (if inp
    inp
    def
  )
)
(defun upoint (bit kwd msg def bpt / inp)
  (if def
    (setq pts (strcat
                (rtos (car def))
                ", "
                (rtos (cadr def))
                (if (and (caddr def) (= 0 (getvar "flatland")))
                  (strcat ", " (rtos (caddr def)))
                  ""
                )
              )
          msg (strcat "\n" msg "<" pts ">: ")
          bit (* (fix (/ bit 2)))
    )
    (setq msg (strcat "\n" msg ": "))
  )
  (initget bit kwd)
  (setq        inp
         (if bpt
           (getpoint msg bpt)
           (getpoint msg)
         )
  )
  (if inp
    inp
    def
  )
)
[/php]

82406515

我不知道拷到什么地方去啊
还有啊你告诉我的那个合并ZE我不知道在那里改，你能不能把你的QQ告诉我啊，这几天把我急死了，我又是初学，不好意思！*-*8

xyp1964

下载后放到cad搜索路径下。
在acad.lsp中增加：
(DEFUN C:ZE () (COMMAND "ZOOM" "E"))
(DEFUN C:dqk() (load"test036")(c:test036))

82406515

你能跟我QQ联系吗184105128谢谢

xyp1964

不会用QQ，呵呵……

82406515

但是我还是不懂啊，因为我是初学者所以不想在上面发帖子，怕人家笑。
我搜索了，但是没搜索到哪个acad.lsp，里面根本就没有啊。你能告诉我你每天什么时候在网上
我好请教，请教你啊

xyp1964

晚上12点，行吗！呵呵……
如果没有acad.lsp，就在cad搜索路径下新建一个acad.lsp文件。

82406515

你帮我搞的那个线上打缺口的错了，我是要在一条已知的线上打任意个缺口呀，

xyp1964

最初由 82406515 发布
[B]你帮我搞的那个线上打缺口的错了，我是要在一条已知的线上打任意个缺口呀， [/B]

任意多条线改缺口线：
[php]
;;;缺口线
(defun c:test036a ()
  (princ"\n选择线 : ")
  (setq        SS    (ssget '((0 . "LINE")))
        dist1 (udist 1 "" "\n\t线长1" dist1 (list 0 0))
        dist2 (udist 1 "" "\n\t线长2" dist2 (list 0 0))
        i     -1
  )
  (vl-cmdf ".undo" "BE")
  (while (setq s1 (ssname ss (setq i (1+ i))))
    (setq pt1 (dxf 10 (entget s1))
          pt2 (dxf 11 (entget s1))
          ang (angle pt1 pt2)
          n1  (fix (/ (distance pt1 pt2) (+ dist1 dist2)))
    )
    (repeat (fix n1)
      (setq pt2        (polar pt1 ang dist1)
            pt3        (polar pt2 ang dist2)
      )
      (command "line" pt1 pt2 "")
      (setq pt1 pt3)
    )
    (entdel s1)
  )
  (vl-cmdf ".undo" "E")
  (princ)
)
(defun udist (bit kwd msg def bpt / inp)
  (if def
    (setq msg (strcat "\n" msg "<" (rtos def) ">:")
          bit (* 2 (fix (/ bit 2)))
    )
    (setq msg (strcat "\n" msg ":"))
  )
  (initget bit kwd)
  (setq        inp
         (if bpt
           (getdist msg bpt)
           (getdist msg)
         )
  )
  (if inp
    inp
    def
  )
)
(defun dxf (code elist) (cdr (assoc code elist)))
[/php]

82406515

大哥，好象还有一点问题，不知道你那个能不能在圆还有椭圆上打那个缺口啊。你看一下，还有啊，我另外有一个计算长度的程序，怎么不能加到那个acad.lisp中去呀。你看能不能帮我想想办法呀》我用的是R14版的

82406515

这就是那个计算长度的程序，怎么会加不到acad.lisp中去啊。我现在用的是每次打开CAD时就要加载一次好麻烦啊。还望大哥你一定回复我。

xyp1964

R14，圆和椭圆不行。
在acad.lsp中增加：
(defun c:ca()(load"ca")(c:ca))

[php]
;;;ca.lsp 计算长度
(defun c:ca (/ os sum i ss en)
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setq        sum 0
        i -1
  )
  (setq ss (ssget '((0 . "CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC"))))
  (repeat (sslength ss)
    (setq en (ssname ss (setq i (1+ i))))
    (command "lengthen" en "")
    (setq sum (+ sum (getvar "perimeter")))
  )
  (setvar "osmode" os)
  sum
)
[/php]

82406515

那小弟就期待你的改进OK！
还有一个问题请教你哦！我那个英文版的R14怎么在插入光栅图象的时候用那个，平移，和缩放速度都很慢怎么搞啊？