daidong013 发表于 2011-6-25 13:59 static/image/common/back.gif
回复 ZZXXQQ 的帖子
非常感谢大侠！~~画完后感觉还是6楼的好用些，因为四面的线都是段开的！~~
ZZXXQQ版编得多么简捷，你还觉得不好用，6#的简单型有改过了，你试试，升级版也出来过，不过不完美，改好再说。。。
本帖最后由 zhynt 于 2011-6-25 15:12 编辑
再来个组合版的：(简版去掉了四边框线)
将;(progn
;(command "_.rectang" nk_pt1 nk_pt3)
(setvar "clayer" "nk_line")
;)
的"号去掉为有框线
(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输入边框宽度:输入0为简版<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)
)
(if (/= wk_kd 0)
(progn
(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 nk_pt1 wk_pt1
nk_pt2 wk_pt2
nk_pt3 wk_pt3
nk_pt4 wk_pt4
)
)
(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)
)
(if (/= wk_kd 0)
(progn
(command "_.rectang" wk_pt1 wk_pt3)
(setvar "clayer" "nk_line")
(command "_.rectang" nk_pt1 nk_pt3)
)
; (progn
; (command "_.rectang" nk_pt1 nk_pt3)
(setvar "clayer" "nk_line")
; )
)
(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)
)
;;;拉框N等分加边距 在ZZXXQQ基础上扩展的
(defun c:tt ()
(setvar "CMDECHO" 0)
(command "undo" "g")
(setq oldos (getvar "OSMODE"))
(if (and(setq p1 (getpoint "\n第一角点 :"))
(setq p2 (getcorner p1 "\n另一角点 :"))
(setq n (getint "\n等分数 :"))
(or (setq d (getreal "\n输入边框宽度:<20mm>:"))
(setq d 20.)
)
)
(progn
(setvar "OSMODE" 0)
(setq dx1 (abs (- (car p2) (car p1)))
dy1 (abs (- (cadr p2) (cadr p1)))
)
(setq ptm (list (min (car p1) (car p2)) (min (cadr p1) (cadr p2)))
p2 (list (max (car p1) (car p2)) (max (cadr p1) (cadr p2)))
p01 ptm
)
(setq p1 (list (+ (car p01) d) (+ (cadr p01) d))
p00 p1
)
;;内基准点
(setq dx (- dx1 (* d 2))
dy (- dy1 (* d 2))
)
(if (> dx dy)
(progn
(setq dd (/ dx n))
(repeat n
(setq p3 (polar p1 0 dd)
p4 (polar p1 (/ pi 2) dy)
p5 (polar p4 0 dd)
)
(command "_.LINE" p1 p5 p3 "")
(setq ent (entlast))
(command "_.LINE" p3 p4 "")
(setq p1 p3)
)
)
(progn
(setq dd (/ dy n))
(repeat n
(setq p3 (polar p1 (/ pi 2) dd)
p4 (polar p1 0 dx)
p5 (polar p3 0 dx)
)
(command "_.LINE" p1 p5 p3 "")
(setq ent (entlast))
(command "_.LINE" p3 p4 "")
(setq p1 p3)
)
)
)
(entdel ent)
(command "RECTANG" p00 p5)
(setvar "OSMODE" oldos)
)
)
(command "undo" "e")
(setvar "CMDECHO" 1)
(princ)
)
回复 zhynt 的帖子
大侠！不错不错，不过怎么没有捕捉呢！！~~
回复 ljpnb 的帖子
真厉害！~~这就是我想要的效果！~~~！~~
不过最外面的外框矩形可以选择有或者没有要怎么改一下！~~
【zhynt】大侠的组合版有最外面的矩形外框！~~
如果加外框，可以在(command "RECTANG" p00 p5)
之后再加一句(command "RECTANG" ptm p2)
回复 ljpnb 的帖子
万分感谢！~~终于完美了！~~~
将关闭捕捉的位置调整了一下：
(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 (/ 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"))
(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输入边框宽度:输入0为简版<20mm>:")
)
(if (= wk_kd nil)
(setq wk_kd 20.0)
)
(setq wk_ptn (list (min (car wk_pt1) (car wk_pt3))
(min (cadr wk_pt1) (cadr wk_pt3))
)
wk_pt3 (list (max (car wk_pt1) (car wk_pt3))
(max (cadr wk_pt1) (cadr wk_pt3))
)
wk_pt1 wk_ptn
)
(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)
)
(if (/= wk_kd 0)
(progn
(setq nk_pt1
(polar wk_pt1
(/ pi 4)
(* wk_kd (* 2 (sqrt 2)))
)
)
(setq nk_pt3
(polar wk_pt3
(/ (* pi 5) 4)
(* 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 nk_pt1 wk_pt1
nk_pt2 wk_pt2
nk_pt3 wk_pt3
nk_pt4 wk_pt4
)
)
(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)
)
(if (< oldos 16384)
(setvar "osmode" (+ oldos 16384))
)
(if (/= wk_kd 0)
(progn
(command "_.rectang" wk_pt1 wk_pt3)
(setvar "clayer" "nk_line")
(command "_.rectang" nk_pt1 nk_pt3)
)
(progn (command "_.rectang" nk_pt1 nk_pt3)
(setvar "clayer" "nk_line")
)
)
(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)
)
本帖最后由 daidong013 于 2011-6-25 18:09 编辑
回复 zhynt 的帖子
现在好了，不错不错！~二合为一！~~感谢！~~
只不过只能识别一个方向的等分，不是识别长边为基础！~~
这样竖向画的时候就有问题！~~
7楼和13楼的可竖画。