2013-05-31 QQ群：ALISP＆VLISP(143438137) 聊天记录：签到

CCarch

阿木林子(1285760615)于2013-05-31 20-46-08：
能不能解决？

梦断江南

狂刀(51050632)于2013-05-31 22-51-13：
签到

CCarch

牵ぶ伱の佑手(379002274)于2013-05-31 22-51-27：
签到

CCarch

流氓兔(871425525)于2013-05-31 22-52-28：
签到

CCarch

牵ぶ伱の佑手(379002274)于2013-05-31 22-52-35：
签到

CCarch

牵ぶ伱の佑手(379002274)于2013-05-31 22-52-45：
  

CCarch

牵ぶ伱の佑手(379002274)于2013-05-31 23-58-58：
给大家个新东西，

CCarch

牵ぶ伱の佑手(379002274)于2013-05-31 23-59-00：
(defun c:vty ()
  (setq clay (getvar "clayer"))                ;取当前图层

  (if (= nil (tblsearch "layer" "VPORTS"))
                                        ;看下有没有vpoint 图层没有就新建
    (command "-layer" "n" "VPORTS" "")
  )
  (command "-layer" "p" "no" "VPORTS" "")
  (setvar "clayer" "VPORTS")                ;新建图层让他不打印
  (setvar "CMDECHO" 0)                        ;参数回显

  (setq osmode(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setvar "ORTHOMODE" 1)

  (while (= nil (setq ent (entsel "\n选中你要的参考视口
  \n如果你现在还没有视口，
  您可以退出现在命令，
  再用fv来建你的前视口\n"))))
  (setq vppoint (cdr (assoc 10 (entget (car ent)))))
                                        ;取出你选中的视口的中心点
  (setq pot1 (getpoint vppoint "点中下个视图的中点"))
  (if (= (car vppoint) (car pot1))        ;判断下你的下个视口的中心位置是什么视图顶视左视正视左视右视
    (setq ay "x")
  )
  (if (= (cadr vppoint) (cadr pot1))
    (setq ay "y")
  )
  ；                                        ;确定要按哪个坐标来转动

  (if (< (cadr vppoint) (cadr pot1))        ;确宝角度大小方向
    (setq ang -90)
  )

  (if (> (cadr vppoint) (cadr pot1))
    (setq ang 90)
  )
  (if (< (car vppoint) (car pot1))
    (setq ang -90)
  )
  (if (> (car vppoint) (car pot1))
    (setq ang 90)
  )
  (command "vpmax" ent)                        ;进入选中的视图
  (command "ucs" "v")
  (command "ucs" ay ang)
  (command "plan" "")
  (command "ucs" "na" "s" "newucs" "y")        ;新建个坐标
                                        ;(command "ucs" "0,0,0" "1,0,0" "0,1,0" "")
  (setq xf (GETVAR "UCSXDIR"))                ;取出x方向
  (setq yf (GETVAR "UCSyDIR"))                ;取出y方向

  (minmix)                                ;取出视图中所有图的最大值

  (command "PSPACE")

  (makvp)                                ;建视口
)



(defun minmix ()                        ;取最大值分程
  (setq rxy (getvar "extmax"))
  (setq lxy (getvar "extmin"))
  (setq minx (- (car rxy) (car lxy)))
  (setq miny (- (cadr rxy) (cadr lxy)))
  (setq minz (- (caddr rxy) (caddr lxy)))
)



(defun makvp ()                                ;要pot1和运行一次minmix
  (setq pot1x (car pot1))
  (setq pot1y (cadr pot1))
                                        ;判断下面的视口外框大小
  (cond        ((= (abs (car xf)) 1.0) (setq minxx minx))
        ((= (abs (cadr xf)) 1.0) (setq minxx miny))
        ((= (abs (caddr xf)) 1.0) (setq minxx minz))
  )
  (cond        ((= (abs (car yf)) 1.0) (setq minyy minx))
        ((= (abs (cadr yf)) 1.0) (setq minyy miny))
        ((= (abs (caddr yf)) 1.0) (setq minyy minz))
  )
                                        ;下面是将视口大小改成最大值的1.2倍
  (setq vp1 (list (- pot1x (/ minxx 1.8)) (+ pot1y (/ minyy 1.8))))
  (setq vp2 (list (+ pot1x (/ minxx 1.8)) (- pot1y (/ minyy 1.8))))

  (command "mview" vp1 vp2)                ;建视口
  (setq sv (entlast))
  (command "mspace")
  (command "move" "all" "" "0,0,0" "0,0,0")
  (command "zoom" "ex")
  (command "ucs" "na" "r" "newucs")
  (command "plan" "")
  (command "zoom" "s" "1xp")
  (command "pspace")
  (command "MVIEW" "h" "on" "all" "")
  (setvar "CMDECHO" 1)
  (setvar "clayer" clay)
  (setvar "OSMODE" OSMODE)
  (princ
    "
\n++++++++++  特声名此程序由：           +++++++
\n++++++++++    胡嘉浚编写               +++++++
\n++++++++++  最终解说权终归胡嘉浚所有   +++++++
\n++++++++++  谢您对我工作的支持         ++++++"
  )
  (princ
  )
)



(defun c:fv ()
    (setq clay (getvar "clayer"))                ;取当前图层
  (setq ctab(getvar "ctab"))

  (if (= nil (tblsearch "layer" "VPORTS"))
                                        ;看下有没有vpoint 图层没有就新建
    (command "-layer" "n" "VPORTS" "")
  )
  (command "-layer" "p" "no" "VPORTS" "")
  (setvar "clayer" "VPORTS")                ;新建图层让他不打印
  (setvar "CMDECHO" 0)
  
  (command "model")
  (command "ucs" "top")
  (minmix)
  (setvar "ctab" ctab)
  (setq cep (getpoint "请输入你的视图中心点"))
  (setq cepx (car cep))
  (setq cepy (cadr cep))
  (setq vp1 (list (- cepx (/ minx 1.8)) (+ cepy (/ minz 1.8))))
  (setq vp2 (list (+ cepx (/ minx 1.8)) (- cepy (/ minz 1.8))))
  (command "mview" vp1 vp2)
    (setq sv (entlast))
  (command "mspace")
  (command "move" "all" "" "0,0,0" "0,0,0")
  (command "zoom" "ex")
  (command "ucs" "fr")
  (command "plan" "")
  (command "zoom" "s" "1xp")
  (command "pspace")
  (command "MVIEW" "h" "on" "all" "")
  (setvar "CMDECHO" 1)
  (setvar "clayer" clay)
  (command "ucs" "v")
  (princ
    "
\n++++++++++  特声名此程序由：           +++++++
\n++++++++++    胡嘉浚编写               +++++++
\n++++++++++  最终解说权终归胡嘉浚所有   +++++++
\n++++++++++  谢您对我工作的支持         ++++++"
  )
  (princ
  )
)