明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1741|回复: 4

图框生成程序移植到R2000时,图框内框与外框重叠,为何如此?请高手指点

[复制链接]
发表于 2003-8-26 18:43:00 | 显示全部楼层 |阅读模式
我将原在R12下编制的图框生成程序移植到R14获得成功,但移植到R2000时,产生奇怪的现象,生成的图框内框与外框重叠,查询内、外框4点的变量却又不相等,所以从理论上说不应重叠。那位大虾能指点一下迷津。
发表于 2003-8-26 18:49:00 | 显示全部楼层
osmode
 楼主| 发表于 2003-9-5 22:33:00 | 显示全部楼层
windows平台
发表于 2004-7-17 19:24:00 | 显示全部楼层
图框生成程序移植到R2000时,图框内框与外框重迭,为何如此?请高手指点
我将原在R12下编制的图框生成程序移植到R14获得成功,但移植到R2000时,产生奇怪的现象,生成的图框内框与外框重迭,查询内、外框4点的变量却又不相等,所以从理论上说不应重迭。那位大虾能指点一下迷津。 源代码:(defun dwgboxset()
(dwgblset)
(pointset)
(lineset)
)

(defun dwgblset()
(if bbx
(if (/= bbx 0.0)
(progn
(setq bbl bbx)
(setq bbx 0.0)
)
)
)
(setq pp (mapcar (quote +) basept (mapcar (quote *) pp (list bbl bbl))))
) (defun pointset()
(command "limits" basept pp)
(command "zoom" "a")
) (defun drawbz (pt / aa pp1 pp2 pp3 pp4)
(setq aa (* 0.020000 (getvar "VIEWSIZE")))
(setq pp1 (mapcar (quote +) pt (list aa aa)))
(setq pp2 (mapcar (quote -) pt (list aa aa)))
(setq pp3 (mapcar (quote +) pt (list aa (- aa))))
(setq pp4 (mapcar (quote -) pt (list aa (- aa))))
(grdraw pp1 pp2 -1)
(grdraw pp3 pp4 -1)
) (defun lineset ()
(command "layer" "m" "tk" "c" "cyan" "" "")
(command "linetype" "s" "bylayer" "")
(command "color" "bylayer") (drabox basept pp 0)
(if (= box "1")
(progn
(setq pt3 (mapcar (quote +) basept (list (* 25 bbl) (* 10 bbl))))
(setq pt4 (mapcar (quote -) pp (list (* 10 bbl) (* 10 bbl))))
)
(progn
(setq pt3 (mapcar (quote +) basept (list (* 25 bbl) (* 5 bbl))))
(setq pt4 (mapcar (quote -) pp (list (* 5 bbl) (* 5 bbl))))
)
)
(drabox pt3 pt4 (* 0.700000 bbl))
(setq pt5 (list (car pt4) (last pt3)))
(setq pt6 (list (car pt3) (last pt4)))
(if (= box "1")
(progn
(command "insert" "tb" pt5 bbl bbl 0)
(command "insert" "hq" pt6 bbl bbl 0)
)
(command "insert" "tb1" pt5 bbl bbl 0)
)
(command "layer" "s" "0" "")
(princ)
(quote nil)
) (defun drabox (p1 p2 wh / p3 p4)
(setq p3 (list (car p2) (cadr p1)))
(setq p4 (list (car p1) (cadr p2)))
(command "pline" p1 "w" wh wh p3 p2 p4 "c")
) (defun c:dwgbox (/ basept basept1 pp nx ny bbl bbx box fd fdd)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(setq fd T fdd nil)

(setq dcl_id (load_dialog "dwgbox.dcl"))
(new_dialog "dwgbox" dcl_id)
(if (not dcl_id) (exit))
(action_tile "a0" "(setq pp '(1189 841))")
(action_tile "a1" "(setq pp '(841 594))")
(action_tile "a2" "(setq pp '(594 420))")
(action_tile "a3" "(setq pp '(420 297))")
(action_tile "a4" "(setq pp '(210 297))")
(action_tile "tw" "(setq nx (atof (get_tile \"tw\")))")
(action_tile "th" "(setq ny (atof (get_tile \"th\")))")
(action_tile "bl1" "(setq bbl 200)")
(action_tile "bl2" "(setq bbl 100)")
(action_tile "bl3" "(setq bbl 50)")
(action_tile "bl4" "(setq bbl 20)")
(action_tile "bl5" "(setq bbl 10)")
(action_tile "bl6" "(setq bbl 1)")
(action_tile "blx" "(setq bbx (atof (get_tile \"blx\")))")
(action_tile "tb1" "(setq box (get_tile \"tb1\"))")
(action_tile "cancel" "(setq fd nil)")
(action_tile "accept" "(done_dialog)") (start_dialog)
(unload_dialog dcl_id)
(if (and nx ny)
(if (and (/= nx 0.0) (/= ny 0.0))
(progn
(setq pp (list nx ny))
(setq nx nil ny nil)
)
)
)
(if (and pp (and (null nx) (null ny))) (setq fdd T))
(if (and (and pp fd) (or bbx bbl) fdd)
(progn
(initget 8)
(setq basept (mapcar (quote +) (getvar "LIMMIN") (quote (0.000000 0.000000))))
(setq basept1 (getpoint "\n请拾取图框左下角点位置:"))
(if (NULL basept1)
(drawbz basept)
(progn
(setq basept basept1)
(drawbz basept)
)
)
(dwgboxset)
)
(if (not fd) (princ "\n*Cancel*\n") (princ "\n参数选择错误!"))
)
(princ)
)
发表于 2005-4-20 21:59:00 | 显示全部楼层
已经解决了.
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-26 06:52 , Processed in 0.156386 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表