【求助】请大侠门来编一个这样的程序！

daidong013 · 发表于 2011-6-25 11:28:00

本帖最后由 daidong013 于 2011-6-25 12:10 编辑

请大侠门编一个这样的程序！

zhynt · 发表于 2011-6-25 11:32:47

本帖最后由 zhynt 于 2011-6-25 11:33 编辑

看不到图！！！

daidong013 · 发表于 2011-6-25 12:11:52

回复 zhynt 的帖子

初次发图没发上去不好意思！~呵呵！~~

zhynt · 发表于 2011-6-25 12:18:15

http://bbs.mjtd.com/thread-87683-1-2.html
看九楼

daidong013 · 发表于 2011-6-25 12:26:19

回复 zhynt 的帖子

九楼这个只是简单的等分工具，没有生成交叉的X线，希望大侠可以编一个！~~期待中！~

ljpnb · 发表于 2011-6-25 13:16:23

本帖最后由 ljpnb 于 2011-6-25 14:37 编辑

简单版的：

(defun c:test (/ p1 p2 p3 p4 n os dx dy xlst ylst l p5 p6 ent1 ent2 ent3)
(setq p1 (getpoint "\n方框第一个角:"))
(setq p2 (getcorner p1 ":\n方框另一个角:"))
(setq n (getint ":\n输入等分数:"))
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(command "undo" "g")
(setq xlst (vl-sort (list (car p1) (car p2)) '<))
(setq ylst (vl-sort (list (cadr p1) (cadr p2)) '<))
(setq dx (- (nth 1 xlst) (nth 0 xlst)))
(setq dy (- (nth 1 ylst) (nth 0 ylst)))
(if (> dx dy)
(progn
(setq p1 (list (nth 1 xlst) (nth 0 ylst))
;;右下角
p2
(polar p1 pi dx)
;;左下角
p3
(polar p2 (* pi 0.5) dy)
;;左上角
p4
(polar p1 (* pi 0.5) dy)
;;右上角
)
(setq l dx)
)
(progn
(setq p1 (list (nth 1 xlst) (nth 1 ylst))
;;右上角
p2
(polar p1 (* pi 1.5) dy)
;;右下角
p3
(polar p2 pi dx)
;;左下角
p4
(polar p1 pi dx)
;;左上角
)
(setq l dy)
)
)
(setq p5 (polar p2 (angle p2 p1) (/ l n)))
(setq p6 (polar p3 (angle p2 p1) (/ l n)))
;;;(command "line" p1 p2 p3 p4 "")
(command "line" p2 p6 "")
(setq ent1 (entlast))
(command "line" p6 p5 "")
(setq ent2 (entlast))
(command "line" p5 p3 "")
(setq ent3 (entlast))
(if (> dx dy)
(progn
(command "-array" ent1 ent3 "" "r" 1 n (/ dx n))
(command "-array" ent2 "" "r" 1 (1- n) (/ dx n))
)
(progn
(command "-array" ent1 ent3 "" "r" n 1 (/ dy n))
(command "-array" ent2 "" "r" (1- n) 1 (/ dy n))
)
)
(command "undo" "e")
(setvar "osmode" os)
(setvar "cmdecho" 1)
(princ)
)

(defun c:test (/ p1 p2 p3 p4 n os dx dy xlst ylst l p5 p6 ent1 ent2 ent3) 
  (setq p1 (getpoint "\n方框第一个角:")) 
  (setq p2 (getcorner p1 ":\n方框另一个角:")) 
  (setq n (getint ":\n输入等分数:")) 
  (setq os (getvar "osmode")) 
  (setvar "osmode" 0) 
  (setvar "cmdecho" 0) 
  (command "undo" "g") 
  (setq xlst (vl-sort (list (car p1) (car p2)) '<)) 
  (setq ylst (vl-sort (list (cadr p1) (cadr p2)) '<)) 
  (setq dx (- (nth 1 xlst) (nth 0 xlst))) 
  (setq dy (- (nth 1 ylst) (nth 0 ylst))) 
  (if (> dx dy) 
    (progn 
      (setq p1 (list (nth 1 xlst) (nth 0 ylst)) 
     ;;右下角 
     p2 
        (polar p1 pi dx) 
     ;;左下角 
     p3 
        (polar p2 (* pi 0.5) dy) 
     ;;左上角 
     p4 
        (polar p1 (* pi 0.5) dy) 
        ;;右上角 
      ) 
      (setq l dx) 
    ) 
    (progn 
      (setq p1 (list (nth 1 xlst) (nth 1 ylst)) 
     ;;右上角 
     p2 
        (polar p1 (* pi 1.5) dy) 
     ;;右下角 
     p3 
        (polar p2 pi dx) 
     ;;左下角 
     p4 
        (polar p1 pi dx) 
        ;;左上角 
      ) 
      (setq l dy) 
    ) 
  ) 
  (setq p5 (polar p2 (angle p2 p1) (/ l n))) 
  (setq p6 (polar p3 (angle p2 p1) (/ l n))) 
;;;(command "line" p1 p2 p3 p4 "") 
  (command "line" p2 p6 "") 
  (setq ent1 (entlast)) 
  (command "line" p6 p5 "") 
  (setq ent2 (entlast)) 
  (command "line" p5 p3 "") 
  (setq ent3 (entlast)) 
  (if (> dx dy) 
    (progn 
      (command "-array" ent1 ent3 "" "r" 1 n (/ dx n)) 
      (command "-array" ent2 "" "r" 1 (1- n) (/ dx n)) 
    ) 
    (progn 
      (command "-array" ent1 ent3 "" "r" n 1 (/ dy n)) 
      (command "-array" ent2 "" "r" (1- n) 1 (/ dy n)) 
    ) 
  ) 
  (command "undo" "e") 
  (setvar "osmode" os) 
  (setvar "cmdecho" 1) 
  (princ) 
)

ZZXXQQ · 发表于 2011-6-25 13:29:21

游客，本帖隐藏的内容需要发帖数高于 5 才可浏览，你当前发帖数只有 0

daidong013 · 发表于 2011-6-25 13:52:06

本帖最后由 daidong013 于 2011-6-25 14:01 编辑

回复 ljpnb 的帖子

不错不错！~非常感谢大侠！~建议简单版的在完成后可以把四边的线去掉！~~
这样就不会有重线的问题了！~~
希望大侠还可以做个升级版的，这样如果是进缩20mm的话四边的线就可以保留了！~~~

daidong013 · 发表于 2011-6-25 13:59:18

回复 ZZXXQQ 的帖子

非常感谢大侠！~~画完后感觉还是6楼的好用些，因为四面的线都是段开的！~~
针对于简单版的最好是矩形的四面都不要线。

zhynt · 发表于 2011-6-25 14:38:08

本帖最后由 zhynt 于 2011-6-25 14:39 编辑

;;升级版的：
(defun err (s)
(if (and
(/= s "console break")
(/= s "Function cancelled")
(/= s "quit/exit abort")
)
(progn
(setvar "LUPREC" oldlup)
(setvar "LUNITS" oldlun)
(setvar "osmode" oldos)
(setvar "cmdecho" oldcmd)
(setvar "clayer" oldlay)
(setq *error* olderr)
(princ (strcat "\n程序出错或用户退出:" s))
)
)
)
(defun c:ldf (/ wk_pt1 wk_pt2 wk_pt3 wk_pt4
nk_pt1 nk_pt2 nk_pt3 nk_pt4 olds
oldcmd oldlup oldlay nk_n nk_kd
ptax ptay ptaz ptbx ptby
ptbz l_pt1_pt4 l_pt2_pt3 l_n ang_pt1_pt4
)
(setq oldos (getvar "osmode"))
(if (< oldos 16384)
(setvar "osmode" (+ oldos 16384))
)
(setq oldcmd (getvar "cmdecho")
oldlun (getvar "LUNITS")
oldlup (getvar "LUPREC")
olderr *error*
*error* err
oldlay (getvar "clayer")
)
(setvar "cmdecho" 0)
(setvar "LUPREC" 8)
(setvar "LUNITS" 2)
(if (= (TBLOBJNAME "LAYER" "wk_line") nil)
(command "layer" "m" "wk_line" "c" "2" "" "")
)
(if (= (TBLOBJNAME "LAYER" "nk_line") nil)
(command "layer" "m" "nk_line" "c" "1" "" "")
)
(setvar "clayer" "wk_line")
(setq wk_pt1 (getpoint "\n指定第一角点")
wk_pt3 (getcorner wk_pt1 "\n指定第二角点:")
nk_n (getint "\n请输入大于零的等分数:")
wk_kd (getreal "\n输入边框宽度<20mm>:")
)
(if (= wk_kd nil)
(setq wk_kd 20.0)
)
(setq ptax (car wk_pt1)
ptay (cadr wk_pt1)
ptbx (car wk_pt3)
ptby (cadr wk_pt3)
)
(setq wk_pt2 (list ptax ptby)
wk_pt4 (list ptbx ptay)
)
(setq nk_pt1
(polar wk_pt1
(/ (- (angle wk_pt1 wk_pt2) (angle wk_pt1 wk_pt4)) 2.0)
(* wk_kd (* 2 (sqrt 2)))
)
)
(setq nk_pt3
(polar wk_pt3
(+ (/ (- (angle wk_pt3 wk_pt2) (angle wk_pt3 wk_pt4)) 2.0)
(/ (* pi 3.0) 2.0)
)
(* wk_kd (* 2 (sqrt 2)))
)
)
(setq ptax (car nk_pt1)
ptay (cadr nk_pt1)
ptbx (car nk_pt3)
ptby (cadr nk_pt3)
)
(setq nk_pt2 (list ptax ptby)
nk_pt4 (list ptbx ptay)
)
(setq l_pt1_pt4 (distance nk_pt1 nk_pt4)
l_pt1_pt2 (distance nk_pt1 nk_pt2)
ang_pt1_pt4 (angle nk_pt1 nk_pt4)
l_n (/ l_pt1_pt4 nk_n)
)
(command "_.rectang" wk_pt1 wk_pt3)
(setvar "clayer" "nk_line")
(command "_.rectang" nk_pt1 nk_pt3)
(setq n_pt1 nk_pt1
n_pt2 nk_pt2
)
(repeat (- nk_n 1)
(setq n_pt3 (polar n_pt1 ang_pt1_pt4 l_n)
n_pt4 (polar n_pt3 (+ ang_pt1_pt4 (/ pi 2.0)) l_pt1_pt2)
)
(command "_.line" n_pt1 n_pt4 n_pt3 n_pt2 "")
(setq n_pt1 n_pt3
n_pt2 n_pt4
)
)
(command "_.line" n_pt1 nk_pt3 "")
(command "_.line" nk_pt4 n_pt2 "")
(setvar "osmode" oldos)
(setvar "cmdecho" oldcmd)
(setvar "clayer" oldlay)
(setvar "LUPREC" oldlup)
(setvar "LUNITS" oldlun)
(princ)
)

;;升级版的： 
(defun err (s) 
  (if (and 
        (/= s "console break") 
        (/= s "Function cancelled") 
        (/= s "quit/exit abort") 
      ) 
    (progn 
      (setvar "LUPREC" oldlup) 
      (setvar "LUNITS" oldlun) 
      (setvar "osmode" oldos) 
      (setvar "cmdecho" oldcmd) 
      (setvar "clayer" oldlay) 
      (setq *error* olderr) 
      (princ (strcat "\n程序出错或用户退出:" s)) 
    ) 
  ) 
) 
(defun c:ldf (/                wk_pt1          wk_pt2    wk_pt3    wk_pt4 
              nk_pt1        nk_pt2          nk_pt3    nk_pt4    olds 
              oldcmd        oldlup          oldlay    nk_n      nk_kd 
              ptax        ptay          ptaz            ptbx      ptby 
              ptbz        l_pt1_pt4 l_pt2_pt3 l_n              ang_pt1_pt4 
             ) 
  (setq oldos (getvar "osmode")) 
  (if (< oldos 16384) 
    (setvar "osmode" (+ oldos 16384)) 
  ) 
  (setq        oldcmd        (getvar "cmdecho") 
        oldlun        (getvar "LUNITS") 
        oldlup        (getvar "LUPREC") 
        olderr        *error* 
        *error*        err 
        oldlay        (getvar "clayer") 
  ) 
  (setvar "cmdecho" 0) 
  (setvar "LUPREC" 8) 
  (setvar "LUNITS" 2) 
  (if (= (TBLOBJNAME "LAYER" "wk_line") nil) 
    (command "layer" "m" "wk_line" "c" "2" "" "") 
  ) 
  (if (= (TBLOBJNAME "LAYER" "nk_line") nil) 
    (command "layer" "m" "nk_line" "c" "1" "" "") 
  ) 
  (setvar "clayer" "wk_line") 
  (setq        wk_pt1 (getpoint "\n指定第一角点") 
        wk_pt3 (getcorner wk_pt1 "\n指定第二角点:") 
        nk_n   (getint "\n请输入大于零的等分数:") 
        wk_kd  (getreal "\n输入边框宽度<20mm>:") 
  ) 
  (if (= wk_kd nil) 
    (setq wk_kd 20.0) 
  ) 
  (setq        ptax (car wk_pt1) 
        ptay (cadr wk_pt1) 
        ptbx (car wk_pt3) 
        ptby (cadr wk_pt3) 
  ) 
  (setq        wk_pt2 (list ptax ptby) 
        wk_pt4 (list ptbx ptay) 
  ) 
  (setq        nk_pt1 
         (polar        wk_pt1 
                (/ (- (angle wk_pt1 wk_pt2) (angle wk_pt1 wk_pt4)) 2.0) 
                (* wk_kd (* 2 (sqrt 2))) 
         ) 
  ) 
  (setq        nk_pt3 
         (polar        wk_pt3 
                (+ (/ (- (angle wk_pt3 wk_pt2) (angle wk_pt3 wk_pt4)) 2.0) 
                   (/ (* pi 3.0) 2.0) 
                ) 
                (* wk_kd (* 2 (sqrt 2))) 
         ) 
  ) 
  (setq        ptax (car nk_pt1) 
        ptay (cadr nk_pt1) 
        ptbx (car nk_pt3) 
        ptby (cadr nk_pt3) 
  ) 
  (setq        nk_pt2 (list ptax ptby) 
        nk_pt4 (list ptbx ptay) 
  ) 
  (setq        l_pt1_pt4   (distance nk_pt1 nk_pt4) 
        l_pt1_pt2   (distance nk_pt1 nk_pt2) 
        ang_pt1_pt4 (angle nk_pt1 nk_pt4) 
        l_n            (/ l_pt1_pt4 nk_n) 
  ) 
  (command "_.rectang" wk_pt1 wk_pt3) 
  (setvar "clayer" "nk_line") 
  (command "_.rectang" nk_pt1 nk_pt3) 
  (setq        n_pt1 nk_pt1 
        n_pt2 nk_pt2 
  ) 
  (repeat (- nk_n 1) 
    (setq n_pt3        (polar n_pt1 ang_pt1_pt4 l_n) 
          n_pt4        (polar n_pt3 (+ ang_pt1_pt4 (/ pi 2.0)) l_pt1_pt2) 
    ) 
    (command "_.line" n_pt1 n_pt4 n_pt3 n_pt2 "") 
    (setq n_pt1        n_pt3 
          n_pt2        n_pt4 
    ) 
  ) 
  (command "_.line" n_pt1 nk_pt3 "") 
  (command "_.line" nk_pt4 n_pt2 "") 
  (setvar "osmode" oldos) 
  (setvar "cmdecho" oldcmd) 
  (setvar "clayer" oldlay) 
  (setvar "LUPREC" oldlup) 
  (setvar "LUNITS" oldlun) 
  (princ) 
)

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

【求助】请大侠门来编一个这样的程序！

本帖子中包含更多资源

浏览过的版块