拉取一个矩形框线并偏移一定距离生成视口如何实现

暮雨晨曦

平时画图在布局会拉取视口框 为了美观 就会在外框处偏移20 画视口 想用个插件解决重复性质的工作




想要达到的想过如图所示 希望有哪位大神出手帮忙 实现这个效果 谢谢~

start4444

(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

2. 
   
3. (or *acad* (setq *acad* (vlax-get-acad-object)))
   
4.   (defun *space (doc)
   
5.     (foreach x '(ActiveDocument ActiveLayout Block) (setq doc (vlax-get doc x)))
   
6.     )
   
7. 
   
8. 
   
9. (defun c:tt ( / p1 p2 WH n ob vp)
   
10.   (setvar 'tilemode 0)
    
11.   (if (and (setq p1 (getpoint "\n左下角 "))
    
12.       
    
13.            (setq p2 (getcorner p1 "\n右上角 "))
    
14.            (progn (initget 6) (setq n (cond ((getdist "\n偏移值 <20> : ")) (20))))
    
15. ;;;           (vl-cmdf "_RECTANG" p1 p2)
    
16.            (setq WH (mapcar ''((x) (- (abs x) (* 2.0 n)) )(mapcar '- p2 p1 '(0. 0.))))
    
17.            (vl-every '(lambda (x) (> x 0.0)) WH)
    
18.            (setq vp (vl-catch-all-apply 'vla-AddPViewport
    
19.                   (vl-list* (*space *acad*) (vlax-3d-point (mapcar ''((a b) (* (+ a b) 0.5)) p1 p2)) WH)
    
20.                   )
    
21.                  )
    
22.            (= (type vp) 'VLA-OBJECT )
    
23.            )
    
24.     (progn
    
25.     (vla-put-viewporton vp 1)(vla-display vp 1)
    
26.     (mapcar ''((a b) (vl-catch-all-apply 'vlax-put (list vp a b)))
    
27.         '(Layer color LineWeight LineType LinetypeScale)
    
28.         '("VPORT" 4 30 "CENTER" 0.03) ;;;参数：图层 颜色 线宽 线型 比例  
    
29.         )
    
30.     )
    
31.     (princ "\n执行无效!")
    
32.     )
    
33.   (princ)
    
34.   )
    
35. 
    

<br /> (or *acad* (setq *acad* (vlax-get-acad-object)))<br />   (defun *space (doc)<br />     (foreach x '(ActiveDocument ActiveLayout Block) (setq doc (vlax-get doc x)))<br />     )<br /> <br /> <br /> (defun c:tt ( / p1 p2 WH n ob vp)<br />   (setvar 'tilemode 0)<br />   (if (and (setq p1 (getpoint "\n左下角 "))<br />        <br />            (setq p2 (getcorner p1 "\n右上角 "))<br />            (progn (initget 6) (setq n (cond ((getdist "\n偏移值 <20> : ")) (20))))<br /> ;;;           (vl-cmdf "_RECTANG" p1 p2)<br />            (setq WH (mapcar ''((x) (- (abs x) (* 2.0 n)) )(mapcar '- p2 p1 '(0. 0.))))<br />            (vl-every '(lambda (x) (> x 0.0)) WH)<br />            (setq vp (vl-catch-all-apply 'vla-AddPViewport<br />                   (vl-list* (*space *acad*) (vlax-3d-point (mapcar ''((a b) (* (+ a b) 0.5)) p1 p2)) WH)<br />                   )<br />                  )<br />            (= (type vp) 'VLA-OBJECT )<br />            )<br />     (progn <br />     (vla-put-viewporton vp 1)(vla-display vp 1)<br />     (mapcar ''((a b) (vl-catch-all-apply 'vlax-put (list vp a b)))<br />         '(Layer color LineWeight LineType LinetypeScale)<br />         '("VPORT" 4 30 "CENTER" 0.03) ;;;参数：图层 颜色 线宽 线型 比例  <br />         )<br />     )<br />     (princ "\n执行无效!")<br />     )<br />   (princ)<br />   )<br /> <br />

试偏移值思路，但视匡口好像有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-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 ...

谢谢您