乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 83|回复: 4

多图框打印(支持斜框)

[复制链接]

13

主题

55

帖子

7

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
105
发表于 2019-12-27 10:18:00 | 显示全部楼层 |阅读模式
刚写好测试量有限,不好用勿喷。
在对话框内只选择打印机、纸张和打印样式,其它自动判断
;;;***************************选择图框打印***************************
(defun c:mpt ()
  (vl-load-com)
  (princ "\n请选择图框:")
  (setq ss0(ssget '((0 . "LWPOLYLINE") (90 . 4))))
  (command "_pagesetup")
  (setq acaddoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq clayout (vla-get-activelayout acaddoc))
  (vla-refreshplotdeviceinfo clayout)
  (setq printname (vla-get-configname clayout))
  (setq papersize (vla-GetLocaleMediaName clayout(vla-get-CanonicalMediaName clayout)))
  (setq PlotStyle (vla-get-stylesheet clayout))
  ;(setq currScale (vla-get-StandardScale clayout)) 获得打印例
  ;(setq printorta (vla-get-plotrotation clayout))
  ;(if(= printorta 0)(setq Rote "L")(setq Rote "P"))  ;;纸的方向
  (setq currscale(getint"\n请选择打印比例1.1:500 2.1:1000 3.1:2000 4.布满:"))
  (if (= currscale 1)(setq printscale 2))
  (if (= currscale 2)(setq printscale 1))
  (if (= currscale 3)(setq printscale 0.5))
  (if (= currscale 4)(setq printscale "F"))
  (if (= currscale nil)(setq printscale "F"))
  (setq osmode_bak (getvar "osmode"));_记录捕捉
  (setq clayer_bak (getvar "clayer"));_记录当前图层
  (setq cecolor_bak (getvar "cecolor"));_记录当色
  (setvar "osmode" 0)
  (setq nn 0)
  (repeat (sslength ss0)
    (setq ss1 nil ss2 nil)
    (setq ent0(entget (ssname ss0 nn)))
    (setq point_list (mapcar 'cdr(vl-remove-if '(lambda (xy) (/= 10 (car xy))) ent0)))
    (setq x->X(vl-sort point_list(function (lambda (e1 e2)(X))
    (setq pointMinX2(cadr x->X))
    (if(DIS(vl-sort point_list(function (lambda (e1 e2)(DIS))
    (setq AcrossSide(last dis->DIS))
    (setq LongSide(caddr dis->DIS))
    (setq Angl1(angle BastPoint LongSide))
    (setq Angl3(angle BastPoint AcrossSide))
    (if(or( angl1 5.5))
      (progn
(setq Angl2(- 0 (*(/ angl1 3.1415)180)))
(setq Rote "L")
      )
      (progn
(setq Angl2(- 90 (*(/ angl1 3.1415)180)))
(setq Rote "P")
      )
    )
    (command "zoom" "e")
    (setq ss1(ssget "cp"  (list BastPoint ShortSide AcrossSide LongSide) ))
    ;(setq addxy(list (+(* nn 500)1000)(+(* nn 500)1000)))
    (setq addxy(list 1000 1000))
    (command "copy" ss1 "" "0,0"  addxy )
    (setq BastPoint1(mapcar '+ addxy  BastPoint ))
    (setq AcrossSide1(mapcar '+ addxy  AcrossSide ))
    (setq ShortSide1(mapcar '+ addxy   ShortSide ))
    (setq LongSide1(mapcar '+ addxy  LongSide ))
    (command "zoom" "e")
    (setq ss2(ssget "cp"  (list BastPoint1 ShortSide1 AcrossSide1 LongSide1)))
    (command "ROTATE" ss2 "" BastPoint1 angl2)
    (setq AcrossSide2(polar BastPoint1(+ angl3(*(/ angl2 180)3.14159))(distance BastPoint1 AcrossSide1)))
    (command "zoom" "e")
    (command "_.PLOT"
        "Y" ;_是否需要详细打印配置?[是(Y)/否(N)] : y
        "" ;_输入布局名或 [?] :
        printname ;_输入输出设备的名称或 [?]
        papersize ;_输入图纸尺寸或 [?] :
        "M" ;_输入图纸单位 [英寸(I)/毫米(M] :
        Rote ;_输入图形方向 [纵向(P)/横向(L)] :
        "N" ;_是否反向打印?[是(Y)/否(N)] :
        "W" ;_输入打印区域 [显示(D)/范围(E)/图形界限(L)/视图(V)/窗口(W)] : w
        BastPoint1 ;_输入窗口的左下角 : 输入窗口的右上角 :
        AcrossSide2;_输入窗口的右上角 :
        printscale ;_输入打印比例 (打印的 毫米=图形单位) 或 [布满(F)] : fit
        "C" ;_输入打印偏移 (x,y) 或 [居中打印(C)] : c
        "Y" ;_是否按样式打印?[是(Y)/否(N)] :
        PlotStyle;_输入打印样式表名称或 [?] (输入 . 表示无) :
        "Y" ;_是否打印线宽?[是(Y)/否(N)] :
        "N" ;_是否删除隐藏线?[是(Y)/否(N)] :
        "N" ;_是否打印到文件 [是(Y)/否(N)] :
        "N" ;_是否保存模型选项卡的修改.
        "n" ;_是否继续打印.
    )
    (command "ERASE" ss2 "")
    (setq nn(+ nn 1))
  )
  (command "zoom" "e")
  (setvar "osmode" osmode_bak);_还原捕捉
  (setvar "clayer" clayer_bak);_还原图层
  (setvar "cecolor" cecolor_bak);_还原颜色
  (princ)
)
回复

使用道具 举报

13

主题

55

帖子

7

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
105
发表于 2019-12-27 10:23:00 | 显示全部楼层
大至思路:将多义线图框内复制移动(1000,1000)之后旋转打印。
回复

使用道具 举报

7

主题

231

帖子

20

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
250
发表于 2019-12-28 12:51:00 | 显示全部楼层
虽然我看不懂代码(没学过)
但是我要点赞,为探索精神
回复

使用道具 举报

0

主题

73

帖子

9

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
71
发表于 2020-1-13 10:12:00 | 显示全部楼层
感谢分享,正在学习图框打印中,很有帮助。
回复

使用道具 举报

0

主题

62

帖子

13

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
57
发表于 2022-7-21 10:52:00 | 显示全部楼层
感謝分享,很有幫助。
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-4 01:17 , Processed in 0.519033 second(s), 62 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表