请 ljpnb 和各位高手进来看看！ 谢谢！

davesnw

我的编程目的是（图在附件里）：有两种情况，一是矩形竖放，在点取完第一个后，第2个可以放在第一个的左边、右边、 上边、下边都可以 （如图上其他编号的矩形），但是必须保证相邻矩形的距离>=1500（如图）。（矩形长2800 宽1400）；能够画6-8个矩形就可以。


第二种情况是矩形横摆（如图）条件同第一种情况。


不知道各位大虾 能否帮小弟个忙！谢谢了

davesnw

还有，请问(setvar "osmode" (logior (getvar "osmode") 16384))


是什么意思啊！谢谢

ljpnb

感觉影响的因素比较多，有点棘手。

davesnw

呵呵！我也感觉是！不行我就一步一步的限制一下条件吧！

无痕

davesnw发表于2005-4-13 15:36:00还有，请问(setvar \"osmode\" (logior (getvar \"osmode\") 16384)) 是什么意思啊！谢谢 相当于按下捕捉切换键

sssssss

试试这个 ;;;----------------------------------------------------------------------------------------------
(defun c:TTT ( / os ce dm msg l-temp agn draw-t nltemp tc a b c dd
pt l1 nl1 ll nn la pp1 pp3 po1 po3 ei tn tc stn tpt tnt)
(command "limits" "0,0" "30000,30000")
(command "_.zoom" "a")
(setq os (getvar "osmode") ce (getvar "cecolor") dm (getvar "dimzin"))
(setvar "osmode" 0)
(setvar "dimzin" 0)
(setq a 2800.0 b 1400.0 c 1500.0 dd 0.000001 l-temp nil tc t tpt t tnt t)
(setq agn (getstring "\nInput Rectangle Orientation Code <0--horizontal/1--vertical>:<0> "))
(if (= agn "")(setq agn 0)(setq agn (read agn)))
(while tnt
(setq tn (getstring "\nInput First Rectangle No. :< 1 >"))
(if (= tn "")
(setq tn 1 tnt nil)
(progn
(setq tn (read tn))
(if (or (= (type tn) 'REAL)
(= (type tn) 'INT))
(setq tnt nil)
)
)
)
)
(while t
(setq draw-t t)
(if tpt
(setq pt (getpoint "\nSelect First Rectangle center point:") tpt nil)
(setq pt (getpoint "\nSelect Next Rectangle center point:"))
)
(if l-temp
(progn
(setq nltemp (length l-temp))
(repeat nltemp
(setq ei (car l-temp) l-temp (cdr l-temp))
(command "_.erase" ei "")
)
)
)
(setq l1 (tp_rec_lt agn (get_exact_rec)) nl1 (length l1) ll l1 nn 0)
(if l1
(repeat nl1
(setq la (car ll) ll (cdr ll) nn (1+ nn))
(setq pp1 (car la) pp3 (cadr la) po1 (nth 4 la) po3 (nth 5 la))
(if (pt_in_area pt pp1 pp3)
(progn
(setvar "cecolor" "1")
(command "_.rectang" po1 po3)
(setq l-temp (append l-temp (list (entlast))) draw-t nil)
(setvar "cecolor" "2")
(setq tc nil)
(draw_new_rec pt agn)
(setq l-temp (append l-temp (list (entlast))) draw-t nil)
(setq tc t)
)
)
)
)
(if draw-t(draw_new_rec pt agn))
);end while by fail input of getpoint and goto *error*
)
;;;--------------------------------------------------------------------------
(defun *error* (msg)
(if l-temp
(progn
(setq nltemp (length l-temp))
(repeat nltemp
(setq ei (car l-temp) l-temp (cdr l-temp))
(command "_.erase" ei "")
)
)
)
(setvar "osmode" os)(setvar "cecolor" ce)(setvar "dimzin" dm)
(princ)
)
;;;---------------------------------------------------------------------------------------
(defun pt_in_area ( pt1 pt2 pt3 / ta xpt1 xpt2 xpt3 ypt1 ypt2 ypt3 zpt1 zpt2 zpt3)
(setq xpt1 (nth 0 pt1) ypt1 (nth 1 pt1) zpt1 (nth 2 pt1))
(setq xpt2 (nth 0 pt2) ypt2 (nth 1 pt2) zpt2 (nth 2 pt2))
(setq xpt3 (nth 0 pt3) ypt3 (nth 1 pt3) zpt3 (nth 2 pt3))
(if (and
(or(and (>= xpt1 xpt2) (<= xpt1 xpt3))(and (<= xpt1 xpt2) (>= xpt1 xpt3)))
(or(and (>= ypt1 ypt2) (<= ypt1 ypt3))(and (<= ypt1 ypt2) (>= ypt1 ypt3)))
;(or(and (>= zpt1 zpt2) (<= zpt1 zpt3))(and (>= zpt1 zpt2) (<= zpt1 zpt3)))
)
(setq ta t)
(setq ta nil)
)
(setq ta ta)
)
;;;--------------------------------------------------------------------------------------
(defun tp_rec_lt ( agn lt-rec-name / ll dx dy nl la po1 po3 pp1 pp3 la-pp lt-rec-pp)
(setq ll lt-rec-name )
(if (= agn 0) (setq dx (/ a 2.0) dy (/ b 2.0)) (setq dx (/ b 2.0) dy (/ a 2.0)))
(if ll
(progn
(setq nl (length ll))
(repeat nl
(setq la (car ll) ll (cdr ll))
(setq po1 (nth 2 la) po3 (nth 3 la)
pp1 (list (- (car po1) dx) (- (cadr po1) dy))
pp3 (list (+ (car po3) dx) (+ (cadr po3) dy))
)
(setq la-pp (append (list pp1 pp3) la))
(if lt-rec-pp
(setq lt-rec-pp (append lt-rec-pp (list la-pp)))
(setq lt-rec-pp (list la-pp))
)
)
)
)
(setq lt-rec-pp lt-rec-pp)
)
;;;--------------------------------------------------------------------------------------
(defun get_exact_rec ( / ss nss nn lt-rec-name lf)
(setq ss (ssget "x" '((0 . "LWPOLYLINE")(90 . 4) (70 . 1))))
(if ss
(progn
(setq nss (sslength ss) nn 0)
(repeat nss
(setq sn (ssname ss nn) en (entget sn))
(if (setq lf (is_rec en a b dd))
(if lt-rec-name
(setq lt-rec-name (append lt-rec-name (list (append (list sn) lf))))
(setq lt-rec-name (list (append (list sn) lf)))
)
)
(setq nn (1+ nn))
)
)
)
(setq lt-rec-name lt-rec-name)
)
;;;-------------------------------------------------------------------------------
(defun draw_new_rec ( pt agn / x0 y0 z0 x1 x2 y1 y2 p1 p2 p3 p4
xo1 xo2 yo1 yo2 po1 po3 os lt en)
(setq x0 (car pt) y0 (cadr pt) z0 (caddr pt))
(if (= agn 0)
(setq dx (/ a 2.0) dy (/ b 2.0))
(setq dx (/ b 2.0) dy (/ a 2.0))
)
(setq x1 (- x0 dx) x2 (+ x0 dx)
y1 (- y0 dy) y2 (+ y0 dy)
xo1 (- x1 c) xo2 (+ x2 c)
yo1 (- y1 c) yo2 (+ y2 c)
)
(setq p1 (list x1 y1)
p2 (list x2 y1)
p3 (list x2 y2)
p4 (list x1 y2)
po1 (list xo1 yo1)
po3 (list xo2 yo2)
)
(if tc (progn
(setvar "cecolor" "4")
(setq stn (rtos tn 2 0) tn (1+ tn))
(command "text" "j" "mc" pt "300" "" stn)
)
)
(command "_.rectang" p1 p3)
(setq en (entlast))
; (setvar "cecolor" "7")
(setq lt (list en pt po1 po3 agn))
)
;;;;;;-------------------------------------------------------------------------------
(defun assoc_n ( m lt n / wt ll la l1 nn nl l0)
(setq ll lt wt 0 nn 0 nl (length ll) l0 nil)
(while wt
(setq la (car ll) ll (cdr ll))
(if (= (car la) m)
(setq l1 la nn (1+ nn))
)
(if (= nn n)
(setq l0 l1 wt nil)
(if (>= wt nl) (setq wt nil))
)
(if wt (setq wt (1+ wt)))
)
(setq l0 l0)
)
;;;----------------------------------------------------------------------------------------------
(defun is_rec ( enlist a b dd / p1 p2 p3 p4 p1x p2x p3x p4x p1y p2y p3y p4y dx12 dx14 dy14 dy12
xmin ymin xmax ymax xcen ycen tt dx dy ag-rec)
(setq p1 (assoc_n 10 enlist 1) p1x (cadr p1) p1y (caddr p1)
p2 (assoc_n 10 enlist 2) p2x (cadr p2) p2y (caddr p2)
p3 (assoc_n 10 enlist 3) p3x (cadr p3) p3y (caddr p3)
p4 (assoc_n 10 enlist 4) p4x (cadr p4) p4y (caddr p4)
dx12 (abs (- p1x p2x)) dx14 (abs (- p1x p4x))
dy14 (abs (- p1y p4y)) dy12 (abs (- p1y p2y))
tt nil
)
(if (or(and (equal p1x p4x dd) (equal p2x p3x dd) (equal p1y p2y dd) (equal p3y p4y dd))
(and (equal p1x p2x dd) (equal p4x p3x dd) (equal p1y p4y dd) (equal p3y p2y dd))
)
(if (or (and (equal dx12 a dd) (equal dy14 b dd))
(and (equal dx12 b dd) (equal dy14 a dd))
(and (equal dx14 a dd) (equal dy12 b dd))
(and (equal dx14 b dd) (equal dy12 a dd))
)
(progn
(setq xmin (min p1x p2x p3x p4x) ymin (min p1y p2y p3y p4y)
xmax (max p1x p2x p3x p4x) ymax (max p1y p2y p3y p4y)
xcen (/ (+ xmin xmax) 2) ycen (/ (+ ymin ymax) 2)
dx (- xmax xmin) dy (- ymax ymin)
)
(if (>= dx dy) (setq ag-rec 0) (setq ag-rec 1))
(setq tt (list (list xcen ycen)
(list (- xmin c) (- ymin c))
(list (+ xmax c) (+ ymax c))
ag-rec
)
)
)
(setq tt nil)
)
)
(setq tt tt)
)
;;;----------------------------------------------------------------------------------------------
(princ "Use Command TTT to draw rectangle.")

ljpnb

6楼程序写得不错哦，向你学习。