发个小程序，设置两点，快速同步【模型·双视口】~~~【20211227尝试修复BUG】
本帖最后由 masterlong 于 2021-12-27 18:58 编辑程序在编制时有疏漏
现尝试修复BUG
因为没有时间测试
暂将修复后的lisp放在35楼
供有兴趣的同学试用
若反映没有问题了再放到顶楼
;;-----------------------------------------------------------------------------------以下代码有bug，见上说明
绘图或者校审过程
经常需要利用双视口
来对照两个平面的同一个区域
;;QG```````模型中直接指定两个点，记录相对坐标后再切分为双视口
;;GG```````根据相对坐标，“同步”两个视口
;;GG```````根据相对坐标，“同步”两个视口
(defun c:gg()
(princ "\nQG```模型中指定两点，记录相对坐标后切分为双视口\nGG```根据相对坐标，“同步”两个视口")
(setq *acad* (vlax-get-acad-object))
(if (null gg#viewlist)
(c:qg)
(if (= (strcase (getvar "ctab")) "MODEL")
(if (= 2 (length (vports)))
(progn
(command "undo" "g")
(setq 0cvid(getvar "cvport"))
(setq 0cvctr (u2w (getvar "viewctr")))
(setq 0cvsize(getvar "viewsize"))
(setq ggbiao (cdr (assoc 0cvid gg#viewlist)))
(setq 9pt (vlax-3d-point (w2u (mapcar '+ 0cvctr (cadr ggbiao)))))
(setvar "cvport" (car ggbiao))
;;【下面代码3选1】
;;(vla-ZoomCenter *acad* 9pt (caddr ggbiao)) ;;按记录默认值显示视窗高度
;;(vla-ZoomCenter *acad* 9pt (* 0cvsize (cadddr ggbiao)));;按相对比例显示视窗高度
(vla-ZoomCenter *acad* 9pt 0cvsize) ;;按第1视口高度设置第2视口高度（手感比较好）
(setvar "cvport" 0cvid)
(princ "\n已根据记录“同步”两个视口")
(command "undo" "e")
)
(princ "\n本命令用于在【模型·双视口】时，按相对位置快速同步两个视口。\n模型空间非双视口，不能执行本命令")
)
(princ "\n本命令用于在【模型·双视口】时，按相对位置快速同步两个视口。\n当前空间非模型，不能执行本命令")
)
)
(princ)
)
;;QG```````模型中直接指定两个点，记录相对坐标后再切分为双视口
(defun c:qg()
(princ "\nQG```模型中指定两点，记录相对坐标后切分为双视口\nGG```根据相对坐标，“同步”两个视口")
(setq *acad* (vlax-get-acad-object))
(if (= (strcase (getvar "ctab")) "MODEL")
(if (and
(setq 0pt (getpoint "\n指定第1视口的中心点 : "))
(setq 1pt (getpoint 0pt "\n指定第2视口的中心点 : "))
)
(progn
(setq 9cvsize(getvar "viewsize"))
(cond
((< 2 (length (vports))) (command "-vports" "si" "-vports" "2" "v"))
((= 1 (length (vports))) (command "-vports" "2" "v"))
)
(setq 0cvid (getvar "cvport"))
(vla-ZoomCenter *acad* (vlax-3d-point 0pt) 9cvsize)
(setvar "cvport" (car (car (reverse (vports)))))
(vla-ZoomCenter *acad* (vlax-3d-point 1pt) 9cvsize)
(setvar "cvport" 0cvid)
(gq_save)
)
(princ "未指定两点。程序退出")
)
(progn
(princ "\n当前空间为布局，本命令只能用于模型，现在切换至模型")
(setvar "ctab" "model")
(c:qg)
)
)
(princ)
)
(defun gq_save()
;;(princ "符合【模型·双视口】条件")
(setq 0cvid(getvar "cvport")) ;;获取当前模型视口的id````模型双视口时，这个值一般为2或3
(setq 0cvctr (u2w (getvar "viewctr")));;获取当前模型视口的中心坐标，转换为世界坐标系
(setq 0cvsize(getvar "viewsize")) ;;获取当前模型视口的高
(setvar "cvport" (car (car (reverse (vports))))) ;;切换至另一个视口
(setq 1cvid(getvar "cvport")) ;;获取第2视口的id
(setq 1cvctr (u2w (getvar "viewctr")));;获取第2视口的中心坐标，转换为世界坐标系
(setq 1cvsize(getvar "viewsize")) ;;获取第2视口的高
(setq 01dist (mapcar '- 1cvctr 0cvctr));;计算0~1视口中心相对坐标
(setq 10dist (mapcar '- 0cvctr 1cvctr));;计算1~0视口中心相对坐标
;;按规则记录`````````````````第4、5个参数备用（根据实际使用手感决定如何调整视窗大小）
(setq gg#viewlist
(list
(list 0cvid 1cvid 01dist 1cvsize (/ 0cvsize 1cvsize 1.0))
(list 1cvid 0cvid 10dist 0cvsize (/ 1cvsize 0cvsize 1.0))
)
)
;;设置所有打开文件共享此列表
;;(vl-propagate 'gg#viewlist)
(setvar "cvport" 0cvid) ;;恢复原始视口
(princ "\n相对坐标已记录。此后可使用【gg】命令快速“同步”")
(princ)
)
;999坐标WCS=>UCS
(defun w2u( pt )
(trans pt 0 1)
)
;999坐标UCS=>WCS
(defun u2w( pt )
(trans pt 1 0)
)
是不是可以增加反应器，达到不需要输入命令自动同步的效果 本帖最后由 masterlong 于 2022-1-4 11:44 编辑
尝试修复BUG
不过没时间测试
先放这里供有兴趣的同学试用
若没有问题
再更新到顶楼
附件传不上来
代码格式又不玩不溜 ------ IE的问题？用google chrome就可以了
就这样吧
;;QG```````模型中指定两点，记录相对坐标后切分为左右双视口````根据两点位置关系自动对应视口
;;GG```````根据相对坐标，“同步”两个视口
;;CCV``````提取以上相对坐标为基点终点，选择对象既完成视口间复制````自动以当前视口向另一视口进行复制
;|
【关于CCV】
这个程序后期我可能会再做一些调整
若当前模型非“左右均分双视口”时
执行CCV仅将模型设为“左右均分双视口”
也就是相当于GG命令的功能
再调用CCV时才允许选择图元执行双向复制
这样应该不容易出现误操作
|;
;000`````````GG```````根据相对坐标，“同步”两个视口
(defun c:gg()
(c:gg_main)
)
(defun c:gg_main()
(princ "\nQG```模型中指定两点，记录相对坐标后切分为双视口\nGG```根据相对坐标，“同步”两个视口")
(setq *acad* (vlax-get-acad-object))
(if (null gg#viewlist)
(c:qg)
(if (= (strcase (getvar "ctab")) "MODEL")
;;改为只要是模型，一律改为左右均分双视口。不管原来是单独视口还是多视口，或者双视口（双视口也可能是上下或不等分视口）
(progn
(command "undo" "g")
;;(set2vp_lr);;设定模型为左右均分双视口
(if (= 2 (length (vports)))
(progn
(setq afw (cdr (car (vports))))
(if (not (or (equal afw '((0.0 0.0) (0.5 1.0))) (equal afw '((0.5 0.0) (1.0 1.0)))))
(command "-vports" "si" "-vports" "2" "v")
)
)
(command "-vports" "si" "-vports" "2" "v")
)
;;根据(vports)特征值，判断当前视口在左还是右
(setq 999cvid (getvar "cvport"))
(setq 999vdat (cdr (assoc 999cvid (vports))))
(setq 999jjj(apply '+ (car 999vdat)))
;;当前为右视口时，ggbiao = gg#viewlist；当前为左视口时，ggbiao = (mapcar '- gg#viewlist)
(if (= 999jjj 0)
(setq ggbiao gg#viewlist)
(setq ggbiao (mapcar '- gg#viewlist))
)
(setq 0cvid(getvar "cvport"))
(setq 0cvctr (u2w (getvar "viewctr")))
(setq 0cvsize(getvar "viewsize"))
(setq 9pt (vlax-3d-point (w2u (mapcar '+ 0cvctr ggbiao))))
(setvar "cvport" (car (car (reverse (vports)))))
(vla-ZoomCenter *acad* 9pt 0cvsize)
(princ "\n已根据记录“同步”两个视口")
(command "undo" "e")
)
(princ "\n本命令用于在【模型·双视口】时，按相对位置快速同步两个视口。\n当前空间非模型，不能执行本命令")
)
)
(princ)
)
;000`````````QG```````模型中指定两点，记录相对坐标后切分为左右双视口````根据两点位置关系自动对应视口
(defun c:QG()
(c:QG_main)
)
(defun c:QG_main()
(princ "\nQG```模型中指定两点，记录相对坐标后切分为左右双视口\nGG```根据相对坐标，“同步”两个视口")
(setq *acad* (vlax-get-acad-object))
;;此代码提至前面————加强程序体验：指定点时，可能视窗面积较大
(setq 9cvsize(getvar "viewsize"))
(if (= (strcase (getvar "ctab")) "MODEL")
(if (and
(setq apt (getpoint "\n指定第1视口的中心点 : "))
(setvar "orthomode" 1)
(setq bpt (getpoint apt "\n指定第2视口的中心点 : "))
)
(progn
;;根据两点坐标比较，确定0pt（始终左视口）1pt（始终右视口）
(setq apt (u2w apt)
bpt (u2w bpt)
)
(if (= (car apt) (car bpt))
(if (> (cadr apt) (cadr bpt))
(setq 0pt apt 1pt bpt)
(setq 0pt bpt 1pt apt)
)
(if (< (car apt) (car bpt))
(setq 0pt apt 1pt bpt)
(setq 0pt bpt 1pt apt)
)
)
;;(set2vp_lr);;设定模型为左右均分双视口
(if (= 2 (length (vports)))
(progn
(setq afw (cdr (car (vports))))
(if (not (or (equal afw '((0.0 0.0) (0.5 1.0))) (equal afw '((0.5 0.0) (1.0 1.0)))))
(command "-vports" "si" "-vports" "2" "v")
)
)
(command "-vports" "si" "-vports" "2" "v")
)
;;根据(vports)特征值，判断当前视口在左还是右
(setq 999cvid (getvar "cvport"))
(setq 999vdat (cdr (assoc 999cvid (vports))))
(setq 999jjj(apply '+ (car 999vdat)))
;;当前为左视口时，切换到右视口
(if (/= 999jjj 0)
(setvar "cvport" (car (car (reverse (vports)))))
)
;;左右视口分别按0pt、1pt缩放窗口
(vla-ZoomCenter *acad* (vlax-3d-point 0pt) 9cvsize)
(setvar "cvport" (car (car (reverse (vports)))))
(vla-ZoomCenter *acad* (vlax-3d-point 1pt) 9cvsize)
(gq_save)
)
(princ "未指定两点。程序退出")
)
(progn
(princ "\n当前空间为布局，本命令只能用于模型，现在切换至模型")
(setvar "ctab" "model")
(c:qg)
)
)
(princ)
)
(defun gq_save()
(setq gg#viewlist (mapcar '- 1pt 0pt))
;;可屏蔽代码`````设置所有打开文档共享此列表
(vl-propagate 'gg#viewlist)
)
;000`````````CCV``````提取以上相对坐标为基点终点，选择对象既完成视口间复制````自动以当前视口向另一视口进行复制
(defun c:ccv()
(c:ccv_main)
)
(defun c:ccv_main()
(princ "\nccv```视口同步复制————————两个视口“同步”以后，以相对坐标进行复制")
(setq *acad* (vlax-get-acad-object))
(if (null gg#viewlist)
(progn
(princ "\n要使用本命令，必须首先指定双视口的相对坐标")
(c:qg)
)
(progn
(command "undo" "g")
;;(set2vp_lr);;设定模型为左右均分双视口
(if (= 2 (length (vports)))
(progn
(setq afw (cdr (car (vports))))
(if (not (or (equal afw '((0.0 0.0) (0.5 1.0))) (equal afw '((0.5 0.0) (1.0 1.0)))))
(command "-vports" "si" "-vports" "2" "v")
)
)
(command "-vports" "si" "-vports" "2" "v")
)
(if (setq ss (ssget))
(progn
;;根据(vports)特征值，判断当前视口在左还是右
(setq 999cvid (getvar "cvport"))
(setq 999vdat (cdr (assoc 999cvid (vports))))
(setq 999jjj(apply '+ (car 999vdat)))
;;当前为右视口时，ggbiao = gg#viewlist；当前为左视口时，ggbiao = (mapcar '- gg#viewlist)
(if (= 999jjj 0)
(setq ggbiao gg#viewlist)
(setq ggbiao (mapcar '- gg#viewlist))
)
(setq ent (entlast))
(command "copy" ss "" "non" '(0 0)"non" ggbiao)
(princ "\n预设点快速复制已完成")
(setq newss (entbackss ent))
;;以下为个人使用习惯，可屏蔽-----复制后对象形成“上一选择集”
(oldss2act newss)
;;以下代码可屏蔽，将取消复制以后视口“同步”的效果
(progn
(setq 0cvid(getvar "cvport"))
(setq 0cvctr (u2w (getvar "viewctr")))
(setq 0cvsize(getvar "viewsize"))
(setq 9pt (vlax-3d-point (w2u (mapcar '+ 0cvctr ggbiao))))
(setvar "cvport" (car (car (reverse (vports)))))
(vla-ZoomCenter *acad* 9pt 0cvsize)
)
;;以下代码可屏蔽，将取消选择集复制后的亮显
(ssdraw ss 3)
(ssdraw newss 3)
(setvar "cvport" 999cvid)
)
)
(command "undo" "e")
)
)
(princ)
)
;999公共函数
;;坐标WCS=>UCS
(defun w2u( pt )
(trans pt 0 1)
)
;999公共函数
;;坐标UCS=>WCS
(defun u2w( pt )
(trans pt 1 0)
)
;999公共函数
;;一个已存在的选择集，设置成当前选择集
(defun oldss2act( oldss )
(sssetfirst Nil oldss);;将选择集设为夹点显示模式
(ssget "i")
(sssetfirst nil nil)
)
;999公共函数
;;按指定的模式重画一个选择集的全部物体<改模式时，需要先反绘。1-2 3-4.(1->4=1->2->4)> 【支持模型多视口，支持布局中视口】
;;1:显示2:消隐3:高亮4:低亮
(defun ssdraw( ss mode / i ent )
(if (= (strcase (getvar "ctab")) "MODEL")
(if (member mode '(1 2 3 4))
(foreach vp (reverse (vports))
(setvar "cvport" (car vp))
(cond
((= (type ss) 'PICKSET)
(foreach ent (ss2list ss)
(redraw ent mode)
)
)
((= (type ss) 'list)
(foreach ent ss
(redraw ent mode)
)
)
((= (type ss) 'ename)
(redraw ss mode)
)
)
)
)
(cond
((= (type ss) 'PICKSET)
(foreach ent (ss2list ss)
(redraw ent mode)
)
)
((= (type ss) 'list)
(foreach ent ss
(redraw ent mode)
)
)
((= (type ss) 'ename)
(redraw ss mode)
)
)
)
(princ)
)
;999```公共函数
;;获取在图元 ent 之后产生的图元的选择集 ，ent不存在时返回nil
(defun entbackss ( ent / backss)
(if (and ent (vlax-Ename->Vla-Object ent))
(progn
(setq backss (ssadd))
(while (setq ent (entnext ent))
(if (not (member (cdr (assoc 0 (entget ent))) '("ATTRIB" "VERTEX" "SEQEND")))
(setq backss (ssadd ent backss))
)
)
(if (zerop (sslength backss))
(setq backss NIL)
)
backss
)
)
)
本帖最后由 masterlong 于 2021-12-27 19:13 编辑
简单说说这个程序的使用方法
如果你有两个平面需要对照
【QG】命令设置两点
第1点设置在平面A的1轴-A轴交点
第2点设置在平面B的1轴-A轴交点
接下来你就可以使用【GG】命令
在两个平面的任意位置进行同一区域的“同步”
如果你面对的是一个多层建筑
当你的工作习惯良好时
这个程序就能最大化发挥出它的作用
很简单
只要各上下层的1-A交点间距完全一致
那么【QG】设置一次以后
你就可以在任意一层平面实现上下层的“同步”
前几天我发布过另一个小程序
先预设基点与终点
再选择对象直接完成复制
其实那个程序就是和这个程序配套的
稍微改一改
将预设基点与终点改为直接提取本程序的相对坐标
就可以实现任意上下平面同一区域的双向复制
;;;;;--------------------------------------------------------------------------------2011227说明
顶楼的QG、QQ程序在编制时有疏漏
现已将修复后程序放到了35楼
欢迎有兴趣的同学试用并反馈
若没有问题了
再更新到顶楼
编程初期的想法和最后的成品
有一定的差距
所以代码有些凌乱
不影响使用就懒得优化了 明天试试效果，龙大师。 好东西哇,非常感谢!!!! 顶一个这个非常实用
不知道是不是我操作问题，我用不了同步啊，当在其中一个视口内放大缩小显示，另外一个视口没有同步显示 本程序的同步并非“实时”
反应器应该可以实现实时同步
但如果真这么做的话
估计会哭死吧 大佬真给力！