视口的图层解冻的VLA方法

炫翔 · 发表于 2013-10-5 11:33:59

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

下面是COMMAND的方法:

;解冻指定视口的指定图层视口名（图元名），图层列表
;(xx-jdjd-name s1 lst)
(defun xx-jdjd-name (s1 lst)
  (foreach x lst
(if(and(member (cons 331 (tblobjname "layer" x)) (entget s1)))
   (command "_.vplayer" "t" x "s" s1 "" "")
)
  )
  (princ)
)

是否可以用VLA方法来实现？

st788796 · 发表于 2013-10-5 12:47:58

本帖最后由 st788796 于 2013-10-5 12:51 编辑

以前尝试过，没有找到方法，貌似这个涉及到视口的Xdata，还有Xrecord，应该还有哪个词典记录
而且这个Xdata是和词典关联，不是简单去除Xdata就能解冻，正因为麻烦Autodesk才提供了vplayer命令

炫翔 · 发表于 2013-10-5 14:11:16

st788796 发表于 2013-10-5 12:47
以前尝试过，没有找到方法，貌似这个涉及到视口的Xdata，还有Xrecord，应该还有哪个词典记录
而且这个Xdat ...

看来是LISP不行了，可怜的DCL不能调用COMMAND

ysq101 · 发表于 2013-10-5 16:43:58

炫翔发表于 2013-10-5 14:11
看来是LISP不行了，可怜的DCL不能调用COMMAND

我记得老猫说可以调用COMMAND的。。我记错了？？

ysq101 · 发表于 2013-10-5 17:06:11

炫翔发表于 2013-10-5 14:11
看来是LISP不行了，可怜的DCL不能调用COMMAND

;这是新手写的LISP 没用到子函数,也没有记录功能
(defun c:tt ()
(setq A (getdist "\n--->请输入第一个数")) ;用子函数代替这行让它有记忆功能
(setq B (getdist "\n--->请输入第二个数"))职;用子函数代替这行
(setq AB (+ A B))
(princ AB)
)
;如果我需要记忆功能,还要写一些IF
;这是炫版主的通用函数有记忆功能的get XXXX
(defun xx-angle (msg def chushi / inp)
(if (= def nil) (setq def chushi))
(setq msg (strcat "\n->请输入提示文字" msg "<" (angtos def) ">:"))
(setq inp (getangle msg))
(if inp inp def)
)
;请教如何才能将炫版主的通用函数代入最上面的LISP
;最主要是学习子函数是如何传递变量的

炫翔 · 发表于 2013-10-5 17:13:00

ysq101 发表于 2013-10-5 17:06

;功能:距离输入格式化。
;(xx-dist msg def chushi)
;参数 msg: 字符串用以提示用户来输入距离值。
; def: 变量（字符串）或字符串，固定的缺省值。
; chushi: 为没有输入任何时为初始值
;获取值:返回实数。
;(setq dist (xx-dist "距离" dist 2.2))
(defun xx-dist (msg def chushi / inp)
(if (= def nil) (setq def chushi))
(setq msg (strcat "\n->请确定" msg "(或直接点两点量取) <" (rtos def) ">:"))
(setq inp(getdist msg))
(if inp inp def)
)

ysq101 · 发表于 2013-10-5 18:26:18

炫翔发表于 2013-10-5 17:13

麻烦直接照我的例子写完整好吗??

st788796 · 发表于 2013-10-5 20:26:54

ysq101 发表于 2013-10-5 18:26
麻烦直接照我的例子写完整好吗??

不要为了函数而写函数，在实践中锤炼

st788796 · 发表于 2013-10-6 11:27:43

搜到一个 VBA 例，用了一个“另类”方法，先把原 Viewport 删除然后按要求的图层控制再新建一个Viewport，

原文如下：

After several request and users saying "Hey you can't do that in VBA" here we go. With the tweedle dee to the tweedle dum of Freezing Layers in a PaperSpace View Port. You got it, THAW a layer in a PaperSpace ViewPort!
First we build a test wrapper to run vpLayerOn
Sub testVplayerOn()
   Dim strLayer As String
   Dim objPviewport As AcadPViewport
   Dim Pt1 As  Variant
   Dim strPrompt As String

   On Error GoTo err_selectVPobjectsToFreeze

   ' set an undo mark in the drawing
   ThisDrawing.StartUndoMark

   If ThisDrawing.ActiveSpace =  acModelSpace Then
      MsgBox "This program only works with  PaperSpace Viewports" & vbCr & _
               "Please go to PaperSpace", vbCritical
      Exit Sub
   End If
' let's get into Paper Space
   ThisDrawing.MSpace = False

   ' Select a viewport
   ThisDrawing.Utility.GetEntity objPviewport, Pt1, "Select  ViewPort:"

   strPrompt = "Enter Layer Name to thaw in Veiw Port: "

   ' Ask the user for a layer to thaw in  the Paperspace View port
   strLayer = ThisDrawing.Utility.GetString(True,  strPrompt)

   ' run the main program that does the grunt of the work
   ' yhea for vpLayer on!
   VpLayerOn strLayer, objPviewport

   ' Place an end to the undo mark
   ThisDrawing.EndUndoMark

   ' exit this sub
   Exit Sub
   ' error handling
err_selectVPobjectsToFreeze:
   MsgBox Err.Description, vbInformation
   Err.Clear
   ThisDrawing.EndUndoMark

End Sub
' Next the VpLayerOn!
Sub VpLayerOn(strLayer As String, objPviewport As AcadPViewport)
   Dim XdataType As Variant
   Dim XdataValue As Variant
   Dim newXdataType As Variant
   Dim newXdataValue As Variant
   Dim I As  Integer
   Dim counter As Integer
   Dim Pt1 As  Variant
   Dim varCenter As Variant
   Dim dblWidth As Double
   Dim dblHeight As Double
   Dim objViewPortNew As AcadPViewport

   ' Get the Xdata from the Viewport
   objPviewport.GetXData "ACAD", XdataType, XdataValue

   For I = LBound(XdataType) To UBound(XdataType)
      ' Look for  frozen Layers in this viewport
      If XdataType(I) = 1003 Then
         ' Set the counter AFTER the position of the Layer frozen  layer(s)
         counter = I +  1
         ' Match the layer we are looking for and exit the sub --
         ' bingo we  have the frozen layer location!
         If UCase(XdataValue(I)) = UCase(strLayer) Then Exit For
      End If
   Next

   ' Layer not found in this Mview
   If counter = 0 Then Exit Sub

' pull Width Height and Center from  selected veiwport
   dblWidth = objPviewport.Width
   dblHeight = objPviewport.Height
   varCenter = objPviewport.Center

   ' set the Xdata for the layer that is  beeing frozen
   newXdataType = XdataType
   newXdataValue = XdataValue

   ' work throught the remaining  array...
   For I = counter To UBound(XdataType)
      ReDim Preserve newXdataType(I - 1)
      ReDim Preserve newXdataValue(I - 1)
      newXdataType(I - 1) = XdataType(I)
      newXdataValue(I - 1) = XdataValue(I)

   Next

   'objViewPortNew.SetXData XdataType,  XdataValue
   Set objViewPortNew =  ThisDrawing.PaperSpace.AddPViewport(varCenter, dblWidth, dblHeight)
   ' Apply xdata to new Pviewport
   objViewPortNew.SetXData newXdataType, newXdataValue
   ' Put the new viewPort on the same  layer as the original viewport
   objViewportNew.Layer = objPviewport.Layer
   ' Refresh viewport!!
   ThisDrawing.MSpace = False
   objViewPortNew.Display (False)
   objViewPortNew.Display (True)
   ThisDrawing.Utility.Prompt ("Done!" & vbCr)

   ' Delete Old viewport
   objPviewport.Delete
End Sub

st788796 · 发表于 2013-10-6 11:41:50

看懂思想就行，关键几句
vla-getxdata
vla-add viewports
vla-setxdata
vla-delete viewport

st788796 · 发表于 2013-10-6 16:06:11

本帖最后由 st788796 于 2013-10-6 16:07 编辑

看了看 DXF , 列出所选视口冻结图层，也许把 1003 组码去掉就可以实现解冻！

(defun c:tt (/ e el ac lst)
(if (and
(zerop (getvar "tilemode"))
(setq e (car (entsel)))
(setq el (entget e '("*")))
(= (cdr (assoc 0 el)) "VIEWPORT")
)
(progn
(setq ac (cdadr (assoc -3 el)))
(if (setq lst (vl-remove-if-not '(lambda (x) (= (car x) 1003)) ac))
(foreach x lst
(princ "\n")
(princ x)
)
(princ "\nNone Layer Freeze!")
)
)
)
(princ)
)

炫翔 · 发表于 2013-10-6 16:10:41

st788796 发表于 2013-10-6 16:06
看了看 DXF , 列出所选视口冻结图层，也许把 1003 组码去掉就可以实现解冻！

没这么简单，只是更新的组码

st788796 · 发表于 2013-10-6 16:47:14

炫翔发表于 2013-10-6 16:10
没这么简单，只是更新的组码

用 VLA 可以
(vla-getxdata vp "ACAD" 'xd 'xt) 获取扩展数据
(safearray-value xd)
(safearray-vlaue xt) 两者是对应的，只要移除 xd 中1003 对应的 xt 数据，然后将 xd xt 用 setxdata 赋予 vla-add 的新视口就可以实现解冻
当然 vla-add 时要从原视口取出视口数据

炫翔 · 发表于 2013-10-6 17:55:51

st788796 发表于 2013-10-6 16:47
用 VLA 可以
(vla-getxdata vp "ACAD" 'xd 'xt) 获取扩展数据
(safearray-value xd)

如果数据很庞大，也许会卡死

st788796 · 发表于 2013-10-6 19:02:40

本帖最后由 st788796 于 2013-10-6 19:42 编辑

炫翔发表于 2013-10-6 17:55
如果数据很庞大，也许会卡死

有多大？在里面都卡不死，你读一下能卡死？！
vla可以冻结，那解冻就是把新建的视口少冻结那几个解冻图层，这样想就有代码了

比如有一个包括冻结图层 1 2 3 的视口，要把图层 1 3 解冻，只要新建一个视口，设置这个视口仅包括冻结图层 2

账号		自动登录	找回密码
密码			立即注册

[研讨] 视口的图层解冻的VLA方法

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

回帖奖励 +1 D豆

点评

点评

点评

点评

点评

点评

评分

评分

点评

点评

点评

点评