不用command自动生成命名视图，修改已命名视图名
本帖最后由 guosheyang 于 2021-6-4 21:34 编辑曾经试图找到一个不用command命令来保存当前视图的vlisp命令，但最后发现都有问题，在论坛也没有搜到，后来自己尝试用autolisp的entmake基本方法写了个类似的，也可以用，共享于此，若有问题，请反馈，谢谢！ 本代码有两个自定义命令一个是对模型空间的视图自动命名保存，二是对已有的命名视图名加以改名
（defun c:ygs_bcst( / stmc)
(setvar 'cmdecho 0)
(setq stmc(getstring "\n请输入要命名屏幕视图的名称："))
(while(=(ygs_viewexist? stmc)t)
(setq stmc(getstring"\n你指定的名称已存在，请重新指定视图名称"))
)
(entmake
(list
(cons 0 "VIEW")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbViewTableRecord")
(cons 2 stmc);视图名称
(cons 41 (* (ygs_kgb)(getvar 'viewsize)));视图宽度
(cons 40 (getvar 'viewsize));;视图高度
(cons 42 50.0);;镜头长度 用默认值
。。。 命名规则 ，默认视图命名为”1” 如果已经有了“1” 则自动后面加一个1
为了能够在论坛下载东西 所以收取1币 若用问题请大家反馈 非常强大的自定义视图程序，感谢 pxt2001 发表于 2022-1-1 15:20
非常强大的自定义视图程序，感谢
谢谢你的肯定！元旦快乐！ 根据楼主的思路，拓展了一下功能。详演示。
加载doslib后，才能运行程序
;;功能：自动保存当前屏幕视图为命名视图
(defun c:v1 ()
(vl-load-com)
(setvar 'cmdecho 0)
;;================================
(or all_lst (setq all_lst '("1目录2墙表 3墙体平面图")))
(Setq kw
;; Dos_Editlist xdrx_ui_Editlist
(Dos_Editlist
"添加、删除或编辑项目，返回列表。PXT: 上下移动取列表第一项"
"创建视图。输入view名称以空格隔开"
all_lst
)
)
(If kw
(progn
(setq all_lst kw)
(Setq N-lst (Fsxm-Split (Car kw) " "))
(Setq N-lst (vl-remove "" N-lst))
(princ (strcat "\n创建了 "
(itoa (length N-lst))
"个视图，视图名称为: "
(Car kw)
)
)
(foreach n N-lst
(setq st_name n)
(if (/= (ygs_viewexist? st_name) t)
(entmake
(list
(cons 0 "VIEW")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbViewTableRecord")
(cons 2 st_name) ;视图名称
(cons 41 (* (ygs_kgb) (getvar 'viewsize))) ;视图宽度
(cons 40 (getvar 'viewsize))
;;视图高度
(cons 42 (getvar 'lenslength))
;;镜头长度 用默认值
(cons 50 (getvar 'viewtwist)) ;扭曲角度
(cons 70 0)
;;View模型空间为0
(cons 10 (trans (getvar 'viewctr) 1 2))
;;视图中心DCS
(cons 11 (trans '(0 0 1) 2 0 t))
;来自目标的观察方向（wcs）
(cons 12 (trans (getvar 'target) 1 0)) ;标点（WCS）
(cons 72 1) ;如果存在与此视图相关联的 UCS，则为 1，否则为
(cons 110 (getvar 'ucsorg)) ;ucs原点
(cons 111 (getvar 'ucsxdir)) ;ucs的X方向矢量
(cons 112 (getvar 'ucsydir)) ;ucs的y方向矢量
)
)
)
)
(setview (tblsearch "view" st_name))
)
)
(setvar 'ucsicon 3)
(setvar 'cmdecho 1)
(princ)
)
(defun c:p ()
(setq out nil)
(setq oviews (vla-get-views
(vla-get-activedocument (vlax-get-acad-object))
)
)
(vlax-for each oviews
(setq out (cons (vla-get-name each) out))
)
(setq out (reverse out))
(if out
(progn
(xdrx_prompt "\n选择已经定义好的视图名称或输入序号<退出>:")
(setq n 0
dosv (mapcar '(lambda (x) (strcat (itoa (setq n (1+ n))) "-" x))
out
)
)
(if (setq i (dos_popupmenu dosv))
(command "view" "r" (nth i out))
)
)
)
(princ)
)
(defun Fsxm-Split (string strkey / po strlst xlen)
(setq xlen (1+ (strlen strkey)))
(while (setq po (vl-string-search strkey string))
(setq strlst (cons (substr string 1 po) strlst))
(setq string (substr string (+ po xlen)))
)
(reverse (cons string strlst))
)
一次框选实现也应该可以 guosheyang 发表于 2022-1-1 21:20
一次框选实现也应该可以
你仔细看看我发的动图。(代码里面对话框需要doslib支持)
功能1：对话框一次性新增了三个视图(1目录，2墙表，3墙体平面图)，视图名称可以对话框交互输入。
功能2：类似鼠标右键菜单的效果，快速切换之前定义好的视图。 感谢大佬分享~
页:
[1]