不用command自动生成命名视图，修改已命名视图名

guosheyang

曾经试图找到一个不用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

guosheyang

为了能够在论坛下载东西 所以收取1币    若用问题请大家反馈

pxt2001

非常强大的自定义视图程序，感谢

guosheyang

pxt2001 发表于 2022-1-1 15:20
非常强大的自定义视图程序，感谢

谢谢你的肯定！元旦快乐！

pxt2001

根据楼主的思路，拓展了一下功能。详演示。


加载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

一次框选实现也应该可以

pxt2001

guosheyang 发表于 2022-1-1 21:20
一次框选实现也应该可以

你仔细看看我发的动图。(代码里面对话框需要doslib支持)
功能1：对话框一次性新增了三个视图(1目录，2墙表，3墙体平面图)，视图名称可以对话框交互输入。
功能2：类似鼠标右键菜单的效果，快速切换之前定义好的视图。

magicheno

感谢大佬分享~