图框生成程序移植到R2000时,图框内框与外框重叠,为何如此?请高手指点
我将原在R12下编制的图框生成程序移植到R14获得成功，但移植到R2000时，产生奇怪的现象，生成的图框内框与外框重叠，查询内、外框4点的变量却又不相等，所以从理论上说不应重叠。那位大虾能指点一下迷津。 osmode windows平台 <b>图框生成程序移植到R2000时,图框内框与外框重迭,为何如此?请高手指点<BR></b>我将原在R12下编制的图框生成程序移植到R14获得成功，但移植到R2000时，产生奇怪的现象，生成的图框内框与外框重迭，查询内、外框4点的变量却又不相等，所以从理论上说不应重迭。那位大虾能指点一下迷津。源代码：(defun dwgboxset()<BR> (dwgblset)<BR> (pointset)<BR> (lineset)<BR>)<BR> <BR>(defun dwgblset()<BR> (if bbx<BR> (if (/= bbx 0.0) <BR> (progn<BR> (setq bbl bbx)<BR> (setq bbx 0.0)<BR> )<BR> )<BR> )<BR> (setq pp (mapcar (quote +) basept (mapcar (quote *) pp (list bbl bbl))))<BR>)
(defun pointset()<BR> (command "limits" basept pp)<BR> (command "zoom" "a")<BR>)
(defun drawbz (pt / aa pp1 pp2 pp3 pp4) <BR> (setq aa (* 0.020000 (getvar "VIEWSIZE"))) <BR> (setq pp1 (mapcar (quote +) pt (list aa aa))) <BR> (setq pp2 (mapcar (quote -) pt (list aa aa))) <BR> (setq pp3 (mapcar (quote +) pt (list aa (- aa)))) <BR> (setq pp4 (mapcar (quote -) pt (list aa (- aa)))) <BR> (grdraw pp1 pp2 -1) <BR> (grdraw pp3 pp4 -1)<BR>)
(defun lineset ()<BR> (command "layer" "m" "tk" "c" "cyan" "" "") <BR> (command "linetype" "s" "bylayer" "") <BR> (command "color" "bylayer")
(drabox basept pp 0) <BR> (if (= box "1")<BR> (progn<BR> (setq pt3 (mapcar (quote +) basept (list (* 25 bbl) (* 10 bbl)))) <BR> (setq pt4 (mapcar (quote -) pp (list (* 10 bbl) (* 10 bbl)))) <BR> )<BR> (progn<BR> (setq pt3 (mapcar (quote +) basept (list (* 25 bbl) (* 5 bbl)))) <BR> (setq pt4 (mapcar (quote -) pp (list (* 5 bbl) (* 5 bbl)))) <BR> )<BR> )<BR> (drabox pt3 pt4 (* 0.700000 bbl)) <BR> (setq pt5 (list (car pt4) (last pt3))) <BR> (setq pt6 (list (car pt3) (last pt4))) <BR> (if (= box "1") <BR> (progn<BR> (command "insert" "tb" pt5 bbl bbl 0) <BR> (command "insert" "hq" pt6 bbl bbl 0)<BR> )<BR> (command "insert" "tb1" pt5 bbl bbl 0)<BR> )<BR> (command "layer" "s" "0" "")<BR> (princ)<BR> (quote nil)<BR>)
(defun drabox (p1 p2 wh / p3 p4) <BR> (setq p3 (list (car p2) (cadr p1))) <BR> (setq p4 (list (car p1) (cadr p2))) <BR> (command "pline" p1 "w" wh wh p3 p2 p4 "c")<BR>)
(defun c:dwgbox (/ basept basept1 pp nx ny bbl bbx box fd fdd)<BR> (setvar "cmdecho" 0)<BR> (setvar "blipmode" 0)<BR> (setq fd T fdd nil)<BR> <BR> (setq dcl_id (load_dialog "dwgbox.dcl"))<BR> (new_dialog "dwgbox" dcl_id)<BR> (if (not dcl_id) (exit))<BR> (action_tile "a0" "(setq pp '(1189 841))")<BR> (action_tile "a1" "(setq pp '(841 594))")<BR> (action_tile "a2" "(setq pp '(594 420))")<BR> (action_tile "a3" "(setq pp '(420 297))")<BR> (action_tile "a4" "(setq pp '(210 297))")<BR> (action_tile "tw" "(setq nx (atof (get_tile \"tw\")))")<BR> (action_tile "th" "(setq ny (atof (get_tile \"th\")))")<BR> (action_tile "bl1" "(setq bbl 200)")<BR> (action_tile "bl2" "(setq bbl 100)")<BR> (action_tile "bl3" "(setq bbl 50)")<BR> (action_tile "bl4" "(setq bbl 20)")<BR> (action_tile "bl5" "(setq bbl 10)")<BR> (action_tile "bl6" "(setq bbl 1)")<BR> (action_tile "blx" "(setq bbx (atof (get_tile \"blx\")))")<BR> (action_tile "tb1" "(setq box (get_tile \"tb1\"))")<BR> (action_tile "cancel" "(setq fd nil)")<BR> (action_tile "accept" "(done_dialog)")
(start_dialog)<BR> (unload_dialog dcl_id)<BR> (if (and nx ny)<BR> (if (and (/= nx 0.0) (/= ny 0.0))<BR> (progn<BR> (setq pp (list nx ny))<BR> (setq nx nil ny nil)<BR> )<BR> )<BR> )<BR> (if (and pp (and (null nx) (null ny))) (setq fdd T))<BR> (if (and (and pp fd) (or bbx bbl) fdd)<BR> (progn<BR> (initget 8) <BR> (setq basept (mapcar (quote +) (getvar "LIMMIN") (quote (0.000000 0.000000)))) <BR> (setq basept1 (getpoint "\n请拾取图框左下角点位置:")) <BR> (if (NULL basept1) <BR> (drawbz basept) <BR> (progn<BR> (setq basept basept1)<BR> (drawbz basept)<BR> )<BR> )<BR> (dwgboxset)<BR> )<BR> (if (not fd) (princ "\n*Cancel*\n") (princ "\n参数选择错误!"))<BR> )<BR> (princ)<BR>)<BR> 已经解决了.
页:
[1]