vqrec : 布局中指定矩形视口，再连续指定切分区域---command版
本帖最后由 masterlong 于 2021-4-10 19:25 编辑源码见2楼
顺便求一下非command程序
程序应用场景说明
图1
图2
图1中的建筑底图是厂房的屋面
实际设计内容仅楼梯间和电梯机房
椭圆圈的几个很小的区域
设计人偷懒直接套了一个A0加长图框
中间图就算了
但是正式出图肯定不能这样
现在需要把有效区域重做视口
再合并到其它平面中图2是合并后的效果
本身我编了一个程序
用于在模型绘制多个矩形直接生成视口
但是模型布局切换实在太慢了
而这个项目里这样操作的需求量是非常非常大
于是有了这样一个程序
直接在已有视口的基础上
切分出多个新视口
;;;;;;vqrec : 布局中指定矩形视口，再连续指定切分区域
(defun c:vqrec()
(princ "\nvqrec : 布局中指定矩形视口，再连续指定切分区域")(princ)
(command "undo" "g")
(setq p1p2list NIL)
(if (and
(setq ss (ssget ":e:s" '((0 . "VIEWPORT"))))
(setq vpent (ssname ss 0))
(setq vpentlist (list vpent))
(zooment vpent 2)
;;获取视口的第1、3角点
(setq vcen (dxf 10 vpent))
(setq vhw (/ (dxf 40 vpent) 2.0))
(setq vhh (/ (dxf 41 vpent) 2.0))
(setq ptvp1 (list (- (car vcen) vhw) (- (cadr vcen) vhh))) ;;原视口右下点
(setq ptvp2 (list (+ (car vcen) vhw) (+ (cadr vcen) vhh))) ;;原视口左上点
;;获取当前屏幕高度，取二百分之一作为框选的尺寸
(setq size (/ (getvar "viewsize") 200.0))
;;获取ptvp1、ptvp2的框选点
(setq ptvp1a (list (+ (car ptvp1) size) (+ (cadr ptvp1) size))
ptvp1b (list (- (car ptvp1) size) (- (cadr ptvp1) size))
)
(setq ptvp2a (list (+ (car ptvp2) size) (+ (cadr ptvp2) size))
ptvp2b (list (- (car ptvp2) size) (- (cadr ptvp2) size))
)
)
(vqrec_getp1p2)
)
(command "undo" "e")
(princ)
)
(defun vqrec_getp1p2()
(if (and
(setq p1 (getpoint "\n指定切分区域第1点 / <右键退出> : "))
(setq p2 (getcorner p1 " ok 指定切分区域第2点 / <右键退出> : "))
(princ " ok ")
)
(progn
(setq p1p2list (cons (list p1 p2) p1p2list))
(command "rectang" "non" p1 "non" p2)
(redraw (entlast) 3)
(setq vpentlist (cons (entlast) vpentlist))
(vqrec_getp1p2)
)
(if p1p2list
(progn
(foreach p1p2 p1p2list
(zooment vpent 2)
(command "copy" vpent "" "non" "0,0" "non" "0,0")
(redraw vpent 2)
(setq p1 (carp1p2))
(setq p2 (cadr p1p2))
;;;;
;;;;vla方法暂时无法实现目的，尝试使用command实现视口角点的拉伸-----成功
;;;;
(command "STRETCH" "c" "non" ptvp1a "non" ptvp1b "" "non" ptvp1 "non" p2)
(command "STRETCH" "c" "non" ptvp2a "non" ptvp2b "" "non" ptvp2 "non" p1)
(redraw vpent 1)
)
(foreach x vpentlist (entdel x))
(princ "\n视口已根据指定区域切分完成")
)
(princ "未绘制矩形，程序结束")
)
)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;--------------公共函数
;999公共函数
;;以指定图元中心缩放窗口
(defun zooment( ent sc / box x midpo h pa pb )
(vla-getboundingbox (vlax-Ename->Vla-Object ent) 'll 'ur)
(setq box (mapcar 'vlax-safearray->list (list ll ur)))
(setq midpo (getmidpo box))
(setq h (abs (- (cadr (cadr box)) (cadr (car box)))))
(setq h (* h (sqrt sc)))
;;;;(vla-zoomwindow (vlax-get-acad-object) (vlax-3d-point pa) (vlax-3d-point pb))
(vla-ZoomCenter(vlax-get-acad-object) (vlax-3d-point midpo) h)
box
)
;999公共函数
;;求点对中点
(defun getmidpo( pts / P1 P2 X Y )
(setq p1 (car pts) p2 (cadr pts))
(if (= (length p1) (length p2))
nil
(setq p1 (list (car p1) (cadr p1))
p2 (list (car p2) (cadr p2))
)
)
(mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) P1 P2)
)
;999公共函数
;;dxf获取图元某个dxf组码（内参不限种类顺序：：： n ent ）
(defun dxf( n ent / temp tmp )
(if (/= (type n) 'int)
(setq tempent
ent n
ntemp
)
)
(if (= (type ent) 'ENAME)
(setq temp (entget ent))
(setq temp ent)
)
(if (= n 62)
(if (setq tmp (assoc n temp))(cdr tmp)256)
(cdr (assoc n temp))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;--------------公共函数
本来想用vla函数改变视口
但是解决不了模型“视点”随视口中心“平移”的问题
无奈采用command的拉伸命令实现需求
下面是未完成的代码
期待高手完善
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;--------------不能实现目标的vla代码
(defun c:vr4()
(setq ss (ssget ":e:s" '((0 . "VIEWPORT"))))
(setq vpent (ssname ss 0))
(setq newobj (vlax-Ename->Vla-Object vpent))
(setq CustomScale (vla-get-CustomScale newobj))
(setq 12dxf (dxf 12 vpent))
(setq p1 (getpoint "\n指定切分区域第1点 / <右键退出> : "))
(setq p2 (getcorner p1 " ok 指定切分区域第2点 / <右键退出> : "))
(princ " ok ")
(setq pt (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) P1 P2))
(setq xdist (abs (- (carp1) (carp2))))
(setq ydist (abs (- (cadr p1) (cadr p2))))
(vla-put-width newobj xdist)
(vla-put-height newobj ydist)
(vla-put-center newobj (vlax-3D-Point pt))
(vla-put-CustomScalenewobj CustomScale)
;|
........... ;;怎么保持模型不随视口中心“平移” ？？？？？
|;
(princ)
) 本帖最后由 叮咚 于 2021-4-12 14:12 编辑
http://www.lee-mac.com/vpoutline.html
可以参考lee mac这个程序，先把画的矩形反到模型空间中，找到中心点。也就是下面代码的中心 vpt
(defun ttx(ptcen vpt ww dd ang blx)
;(setq ptcenx (mapcar '(lambda(xx)(/ xx 1.0 blx)) ptcen))
(setq obj_mv (vlax-invoke-method aps "AddPViewport" (vlax-3D-point ptcen) (+ (/ ww blx) 0.0) (+ (/ hh blx) 0.0)))
(vlax-put-property obj_mv "Layer" "0-视口")
(vlax-put-property obj_mv "Color" acYellow)
(vlax-put-property obj_mv "ViewportOn" acTrue)
(vlax-put-property obj_mv "TwistAngle" (* -1 ang))
(vlax-put-property obj_mv "GridOn" acFalse)
; ActivePViewport示例中有以下说明
;' 在将图纸空间 Viewport 设为活动前，mspace 属性必须为 True
;ThisDrawing.mspace = True
;ThisDrawing.ActivePViewport = newPViewport
(vlax-put-property adoc_l "ActiveSpace" acPaperspace)
(vlax-invoke-method (vlax-get-property acad_l "Application") "ZoomExtents")
(vlax-put-property adoc_l "MSpace" acTrue)
(vlax-put-property adoc_l "ActivePViewport" obj_mv)
;(vlax-put-property adoc_l "ActivePViewport" obj_mv)
(vlax-invoke-method (vlax-get-property acad_l "Application") "ZoomCenter" (vlax-3D-point vpt) 1.0)
(vlax-put-property adoc_l "MSpace" acFalse)
(vlax-put-property obj_mv "CustomScale" (/ 1.0 blx))
;(vlax-invoke-method (vlax-get-property acad_l "Application") "ZoomPrevious")
)
找时间我们聊聊这个问题吧 论坛里参照、视口相关的程序
还是太少了
一直想把自己的一些程序放上来
等有空时整理整理 计算拉伸后视口对应的模型中心点
这个不难
问题是怎么修改
vla貌似没有方法
entmod对视口图元好像也无效
我好像走入误区了？
进入到视口内部
直接vla-ZoomCenter
就不知道速度方面怎么样
等会测试下 masterlong 发表于 2021-4-12 14:53
我好像走入误区了？
进入到视口内部
直接vla-ZoomCenter
对啊，我发你的代码中，就是这样啊 初步测试
感觉进入视口zoom中心点的做法
比直接视口拉伸要慢好多
差不多1：2的关系
command方式
copy以前先冻结全部图层
拉伸全部完成以后再恢复图层
时间上又能省一半
当然耗时这个不好说
这和模型图元数量
布局视口数量以及切分数量等等
都有很大的关系
页:
[1]
2