拉取一个矩形框线并偏移一定距离生成视口如何实现
平时画图在布局会拉取视口框 为了美观 就会在外框处偏移20 画视口 想用个插件解决重复性质的工作想要达到的想过如图所示 希望有哪位大神出手帮忙 实现这个效果 谢谢~
(defun c:tt5 ()
(setvar "LTSCALE" 30)
(setq p1 (getpoint"\n点1:") p2 (getcorner p1"\n点2:"))
(command "RECTANG" "non" p1 "non" p2)
(setq rc1 (entlast) dis (if (setq dis (getdist"\n偏移距离<20>:")) dis 20))
(command "OFFSET" dis rc1 "non" (mid_pt p1 p2) "" "CHANGE" (entlast) "" "p" "c" 4 "p" "lt" "center" "" "pedit" (entlast) "w" 0.5 "" "MVIEW" "o" (entlast) "ERASE" rc1 "")
(princ)
)
(defun mid_pt (a b) ;中点函数
(mapcar
'(lambda (a b) (/ (+ a b) 2))
a
b
)
)
lisperado 发表于 2019-11-3 12:34
尝试偏移值思路，但视匡口好像有bug? 创建成功却无法打开进入！星期天出街了，没时间调试！
谢谢您的帮助 但是测试发现有些问题 看您方便帮助调整下
1. 输入的偏移值是得到结果的四分之一（如输入偏移值为20 实际偏移距离为5）
2. 最初框定范围的矩形框仍然存在 可否去掉
3.正如您所说 生成了视口 但是如法进入
如果不能生成视口 按照我图中所示 生成那种样式（颜色 线宽线型及比例图层 ）的矩形框也可
谢谢~ 本帖最后由 lisperado 于 2019-11-5 01:26 编辑
(or *acad* (setq *acad* (vlax-get-acad-object)))
(defun *space (doc)
(foreach x '(ActiveDocument ActiveLayout Block) (setq doc (vlax-get doc x)))
)
(defun c:tt ( / p1 p2 WH n ob vp)
(setvar 'tilemode 0)
(if (and (setq p1 (getpoint "\n左下角 "))
(setq p2 (getcorner p1 "\n右上角 "))
(progn (initget 6) (setq n (cond ((getdist "\n偏移值 <20> : ")) (20))))
;;; (vl-cmdf "_RECTANG" p1 p2)
(setq WH (mapcar ''((x) (- (abs x) (* 2.0 n)) )(mapcar '- p2 p1 '(0. 0.))))
(vl-every '(lambda (x) (> x 0.0)) WH)
(setq vp (vl-catch-all-apply 'vla-AddPViewport
(vl-list* (*space *acad*) (vlax-3d-point (mapcar ''((a b) (* (+ a b) 0.5)) p1 p2)) WH)
)
)
(= (type vp) 'VLA-OBJECT )
)
(progn
(vla-put-viewporton vp 1)(vla-display vp 1)
(mapcar ''((a b) (vl-catch-all-apply 'vlax-put (list vp a b)))
'(Layer color LineWeight LineType LinetypeScale)
'("VPORT" 4 30 "CENTER" 0.03) ;;;参数：图层 颜色 线宽 线型 比例
)
)
(princ "\n执行无效!")
)
(princ)
)
试偏移值思路，但视匡口好像有bug?
start4444 发表于 2019-11-3 19:15
(defun c:tt5 ()
(setvar "LTSCALE" 30)
(setq p1 (getpoint"\n点1:") p2 (getcorner p1"\n点2:"))
谢谢您 就是这个效果 本帖最后由 lisperado 于 2019-11-5 01:12 编辑
暮雨晨曦 发表于 2019-11-3 15:09
谢谢您的帮助 但是测试发现有些问题 看您方便帮助调整下
1. 输入的偏移值是得到结果的四分之一（如输 ...
提问1. 输入的偏移值是得到结果的四分之一（如输入偏移值为20 实际偏移距离为5）
回复： (setq WH (mapcar '(lambda (x) (- (abs x) (* 0.5 n))) (mapcar '- p2 p1 '(0. 0.))))
举例如果宽度=200，偏移值20也就是说 200-(20x2) = (- 200 (* 2.0 n) )
发源码的目的是让你调试后如果有误可以自行修改0.5为2.0
注意：如果偏移默认值大过视口如何处理？
提问2. 最初框定范围的矩形框仍然存在 可否去掉
回复： 很简单删除这一段 (vl-cmdf "_RECTANG" p1 p2)
提问3.正如您所说 生成了视口 但是如法进入
回复： 可以利用vlax-dump-object查看视口设定/参数viewporton值原来是=0 :vlax-false
vla-put-viewporton打开改视口设定为= 1
至于颜色 线宽线型比例图层等等可用vla-put-属性自行修改
检查属性参数如下
Command: (vlax-dump-object (vlax-ename->vla-object (car(entsel))) t)
视口的参数如下
Select object: ; IAcadPViewport: IAcadPViewport Interface
; Property values:
; Application (RO) = #<VLA-OBJECT IAcadApplication 0000000140142308>
; ArcSmoothness = 1000
; Center = (128.5 97.5 0.0)
; Clipped (RO) = 0
; CustomScale = 16.9044
; Direction = (0.0 0.0 1.0)
; DisplayLocked = 0
; Document (RO) = #<VLA-OBJECT IAcadDocument 000000002c268398>
; EntityTransparency = "ByLayer"
; GridOn = -1
; Handle (RO) = "1D1"
; HasExtensionDictionary (RO) = -1
; HasSheetView (RO) = 0
; Height = 156.0
; Hyperlinks (RO) = #<VLA-OBJECT IAcadHyperlinks 000000002c162a18>
; LabelBlockId = 0
; LabelBlockId32 = 0
; Layer = "0"
; LayerPropertyOverrides (RO) = 0
; LensLength = 50.0
; Linetype = "ByLayer"
; LinetypeScale = 1.0
; Lineweight = -1
; Material = "ByLayer"
; ModelView = nil
; ObjectID (RO) = 49
; ObjectID32 (RO) = 49
; ObjectName (RO) = "AcDbViewport"
; OwnerID (RO) = 48
; OwnerID32 (RO) = 48
; PlotStyleName = "ByLayer"
; ShadePlot = 0
; SheetView = nil
; SnapBasePoint = (0.0 0.0)
; SnapOn = 0
; SnapRotationAngle = 0.0
; StandardScale = 1
; StandardScale2 = 1
; Target = (0.0 0.0 0.0)
; TrueColor = #<VLA-OBJECT IAcadAcCmColor 000000002c1625f0>
; TwistAngle = 0.0
; UCSIconAtOrigin = -1
; UCSIconOn = -1
; UCSPerViewport = -1
; ViewportOn = -1
; Visible = -1
; VisualStyle = 1
; Width = 205.6
太忙只有睡前随笔修改请看二楼
自行调试修改吧 lisperado 发表于 2019-11-5 00:48
提问1. 输入的偏移值是得到结果的四分之一（如输入偏移值为20 实际偏移距离为5）
回复： (s ...
谢谢您
页:
[1]