CAD开发者社区

 找回密码
 立即注册

QQ登录

只需一步,快速开始

ActiveX 开发指南

相关分类

扭曲属性 (ActiveX)

2023-1-3 02:37| 发布者: admin| 查看: 222| 评论: 0|来自: AutoCAD

摘要: 控制螺旋的扭转方向或指定沿扫描路径整个长度的旋转量。

控制螺旋的扭转方向或指定沿扫描路径整个长度的旋转量。

支持的平台:仅窗口

签名

工 务 局:

object.Twist
对象

类型:螺旋后掠面

此属性适用的对象。

属性值 - 螺旋

只读:

类型:枚举AcHelixTwistType

扭转方向。

  • acCCW:反时针方向的
  • acCW:顺时针

属性值 - 扫描表面

只读:

类型:ACAD_ANGLE

沿扫描路径的旋转量。

言论

没有额外的评论。

示例 - 螺旋

工 务 局:

Sub Example_Helix_BaseRadius()
    Dim ssetObj As AcadSelectionSet
    Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_HELIX")
    Dim mode As Integer
    
    AppActivate ThisDrawing.Application.Caption
    
    ssetObj.SelectOnScreen
    
    Dim obj As AcadEntity
    Dim helix As AcadHelix
    Dim helixBaseRadius As Double
    Dim objName As String
    For Each obj In ssetObj
        objName = obj.ObjectName
            If TypeOf obj Is AcadHelix Then
            Set helix = obj
            helix.BaseRadius = helix.BaseRadius * 2
            MsgBox "Baseradius of helix is doubled to " & helix.BaseRadius * 2
            End If
    Next
    ssetObj.Delete
End Sub

Sub Example_Helix_TopRadius()
    Dim ssetObj As AcadSelectionSet
    Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_HELIX")
    Dim mode As Integer
    
    AppActivate ThisDrawing.Application.Caption
    
    ssetObj.SelectOnScreen
    
    Dim obj As AcadEntity
    Dim helix As AcadHelix
    Dim helixBaseRadius As Double
    Dim objName As String
    For Each obj In ssetObj
        objName = obj.ObjectName
            If TypeOf obj Is AcadHelix Then
            Set helix = obj
            helix.TopRadius = helix.TopRadius * 0.5
            MsgBox "Top radius of helix is halved to " & helix.TopRadius * 0.5
            End If
    Next
    ssetObj.Delete
End Sub

Sub Example_Helix_Direction()
    Dim ssetObj As AcadSelectionSet
    Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_HELIX")
    Dim mode As Integer
    
    AppActivate ThisDrawing.Application.Caption
    
    ssetObj.SelectOnScreen
    
    Dim obj As AcadEntity
    Dim helix As AcadHelix
    Dim helixBaseRadius As Double
    Dim objName As String
    For Each obj In ssetObj
        objName = obj.ObjectName
            If TypeOf obj Is AcadHelix Then
            Set helix = obj
            If helix.Twist = acCCW Then
                helix.Twist = acCW
            Else
                helix.Twist = acCCW
            End If
            MsgBox "Direction is reversed"
            End If
    Next
    ssetObj.Delete
End Sub

Sub Example_Helix_Height()
    Dim ssetObj As AcadSelectionSet
    Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_HELIX")
    Dim mode As Integer
    
    AppActivate ThisDrawing.Application.Caption
    
    ssetObj.SelectOnScreen
    
    Dim obj As AcadEntity
    Dim helix As AcadHelix
    Dim helixBaseRadius As Double
    Dim objName As String
    For Each obj In ssetObj
        objName = obj.ObjectName
            If TypeOf obj Is AcadHelix Then
            Set helix = obj
            helix.Constrain = acHeight
            helix.height = helix.height * 2
            MsgBox "Height doubled"
            End If
    Next
    ssetObj.Delete
End Sub

Sub Example_Helix_Turns()
    Dim ssetObj As AcadSelectionSet
    Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_HELIX")
    Dim mode As Integer
    
    AppActivate ThisDrawing.Application.Caption
    
    ssetObj.SelectOnScreen
    
    Dim obj As AcadEntity
    Dim helix As AcadHelix
    Dim helixBaseRadius As Double
    Dim objName As String
    For Each obj In ssetObj
        objName = obj.ObjectName
            If TypeOf obj Is AcadHelix Then
            Set helix = obj
            helix.Constrain = acTurns
            helix.Turns = helix.Turns * 2
            MsgBox "Turns doubled"
            End If
    Next
    ssetObj.Delete
End Sub

Sub Example_Helix_TurnHeight()
    Dim ssetObj As AcadSelectionSet
    Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_HELIX")
    Dim mode As Integer
    
    AppActivate ThisDrawing.Application.Caption
    
    ssetObj.SelectOnScreen
    
    Dim obj As AcadEntity
    Dim helix As AcadHelix
    Dim helixBaseRadius As Double
    Dim objName As String
    For Each obj In ssetObj
        objName = obj.ObjectName
            If TypeOf obj Is AcadHelix Then
            Set helix = obj
            helix.Constrain = acTurnHeight
            helix.TurnHeight = helix.TurnHeight * 2
            MsgBox "Turns height doubled"
            End If
    Next
    ssetObj.Delete
End Sub

Visual LISP:

(vl-load-com)
(defun c:Example_Helix_BaseRadius()
    (setq acadObj (vlax-get-acad-object))
    (setq doc (vla-get-ActiveDocument acadObj))
  
    (setq ssetObj (vla-Add (vla-get-SelectionSets doc) "TEST_HELIX"))
    (vla-SelectOnScreen ssetObj)
    
    (vlax-for obj ssetObj
        (setq objName (vla-get-ObjectName obj))
        (if (= objName "AcDbHelix")
            (progn
                (setq helix obj)
                (vla-put-BaseRadius helix (* (vla-get-BaseRadius helix) 2))
                (alert (strcat "Baseradius of helix is doubled to " (rtos (vla-get-BaseRadius helix) 2)))
            )
        )
    )
    (vla-Delete ssetObj)
)

(defun c:Example_Helix_TopRadius()
    (setq acadObj (vlax-get-acad-object))
    (setq doc (vla-get-ActiveDocument acadObj))
  
    (setq ssetObj (vla-Add (vla-get-SelectionSets doc) "TEST_HELIX"))
    (vla-SelectOnScreen ssetObj)
    
    (vlax-for obj ssetObj
        (setq objName (vla-get-ObjectName obj))
        (if (= objName "AcDbHelix")
            (progn
                (setq helix obj)
                (vla-put-TopRadius helix (* (vla-get-TopRadius helix) 0.5))
                (alert (strcat "Top radius of helix is halved to " (rtos (vla-get-TopRadius helix) 2)))
            )
        )
    )
    (vla-Delete ssetObj)
)

(defun c:Example_Helix_Direction()
    (setq acadObj (vlax-get-acad-object))
    (setq doc (vla-get-ActiveDocument acadObj))
  
    (setq ssetObj (vla-Add (vla-get-SelectionSets doc) "TEST_HELIX"))
    (vla-SelectOnScreen ssetObj)
    
    (vlax-for obj ssetObj
        (setq objName (vla-get-ObjectName obj))
        (if (= objName "AcDbHelix")
            (progn
                (setq helix obj)
	        (if (= (vla-get-Twist helix) acCCW)
	            (vla-put-Twist helix acCW)
	            (vla-put-Twist helix acCCW)
	        )
                (alert "Direction is reversed")
            )
        )
    )
    (vla-Delete ssetObj)
)

(defun c:Example_Helix_Height()
    (setq acadObj (vlax-get-acad-object))
    (setq doc (vla-get-ActiveDocument acadObj))
  
    (setq ssetObj (vla-Add (vla-get-SelectionSets doc) "TEST_HELIX"))
    (vla-SelectOnScreen ssetObj)
    
    (vlax-for obj ssetObj
        (setq objName (vla-get-ObjectName obj))
        (if (= objName "AcDbHelix")
            (progn
                (setq helix obj)
                (vla-put-Constrain helix acHeight)
                (vla-put-Height helix (* (vla-get-Height helix) 2))
                (alert "Height doubled")
            )
        )
    )
    (vla-Delete ssetObj)
)

(defun c:Example_Helix_Turns()
    (setq acadObj (vlax-get-acad-object))
    (setq doc (vla-get-ActiveDocument acadObj))
  
    (setq ssetObj (vla-Add (vla-get-SelectionSets doc) "TEST_HELIX"))
    (vla-SelectOnScreen ssetObj)
    
    (vlax-for obj ssetObj
        (setq objName (vla-get-ObjectName obj))
        (if (= objName "AcDbHelix")
            (progn
                (setq helix obj)
                (vla-put-Constrain helix acTurns)
                (vla-put-Turns helix (* (vla-get-Turns helix) 2))
                (alert "Turns doubled")
            )
        )
    )
    (vla-Delete ssetObj)
)

(defun c:Example_Helix_TurnHeight()
    (setq acadObj (vlax-get-acad-object))
    (setq doc (vla-get-ActiveDocument acadObj))
  
    (setq ssetObj (vla-Add (vla-get-SelectionSets doc) "TEST_HELIX"))
    (vla-SelectOnScreen ssetObj)
    
    (vlax-for obj ssetObj
        (setq objName (vla-get-ObjectName obj))
        (if (= objName "AcDbHelix")
            (progn
                (setq helix obj)
                (vla-put-Constrain helix acTurnHeight)
                (vla-put-TurnHeight helix (* (vla-get-TurnHeight helix) 2))
                (alert "Turns height doubled")
            )
        )
    )
    (vla-Delete ssetObj)
)

Examples - SweptSurface

VBA:

Sub SurfaceProperties()
    Dim ssetObj As AcadSelectionSet
    Set ssetObj = ThisDrawing.SelectionSets.Add("SURFACES2")
    Dim mode As Integer

    AppActivate ThisDrawing.Application.Caption
    
    ssetObj.SelectOnScreen

    Dim obj As AcadEntity
    Dim extrude As AcadExtrudedSurface
    Dim objName As String
    Dim LayerName As String
    For Each obj In ssetObj
        objName = obj.ObjectName
        If TypeOf obj Is AcadExtrudedSurface Then
            ExtrudedSurfaceProperties obj
        ElseIf TypeOf obj Is AcadRevolvedSurface Then
            RevolvedSurfaceProperties obj
        ElseIf TypeOf obj Is AcadLoftedSurface Then
            LoftedSurfaceProperties obj
        ElseIf TypeOf obj Is AcadSweptSurface Then
            SweptSurfaceProperties obj
        ElseIf TypeOf obj Is AcadPlaneSurface Then
            PlaneSurfaceProperties obj
        End If
    Next

    ssetObj.Delete
End Sub

Private Sub ExtrudedSurfaceProperties(extrude As AcadExtrudedSurface)
    AppActivate ThisDrawing.Application.Caption
    
    GetSurfaceBoundingBox extrude
    MsgBox "SurfaceType: " & extrude.SurfaceType & vbCr & _
           "Height: " & extrude.height & vbCr & _
           "TaperAngle: " & extrude.TaperAngle & vbCr & _
           "Direction: " & extrude.Direction & vbCr & _
           "Material: " & extrude.Material & vbCr & _
           "UIsolineDensity: " & extrude.UIsolineDensity & vbCr & _
           "VIsolineDensity: " & extrude.VIsolineDensity

    'Now change the configurable properties
    extrude.height = extrude.height * 1.5
    extrude.TaperAngle = extrude.TaperAngle * (3.14 / 2)
    extrude.UIsolineDensity = extrude.UIsolineDensity * 2#
    extrude.VIsolineDensity = extrude.VIsolineDensity * 0.5
    ThisDrawing.Regen acActiveViewport
    Utility.GetString 0, "Press return to continue..."

    'Now change the properties back to their original values
    extrude.height = extrude.height / 1.5
    extrude.TaperAngle = extrude.TaperAngle / (3.14 / 2)
    extrude.UIsolineDensity = extrude.UIsolineDensity / 2#
    extrude.VIsolineDensity = extrude.VIsolineDensity / 0.5
End Sub

Private Sub RevolvedSurfaceProperties(revolve As AcadRevolvedSurface)
    AppActivate ThisDrawing.Application.Caption
    
    GetSurfaceBoundingBox revolve
    MsgBox "SurfaceType: " & revolve.SurfaceType & vbCr & _
           "RevolutionAngle: " & revolve.RevolutionAngle & vbCr & _
           "AxisPosition: " & revolve.AxisPosition & vbCr & _
           "AxisDirection: " & revolve.AxisDirection & vbCr & _
           "Material: " & revolve.Material & vbCr & _
           "UIsolineDensity: " & revolve.UIsolineDensity & vbCr & _
           "VIsolineDensity: " & revolve.VIsolineDensity

    'Now change the configurable properties
    revolve.RevolutionAngle = revolve.RevolutionAngle * (3.14 / 2)

    revolve.UIsolineDensity = revolve.UIsolineDensity * 2#
    revolve.VIsolineDensity = revolve.VIsolineDensity * 0.5

    ThisDrawing.Regen acActiveViewport
    Utility.GetString 0, "Press return to continue..."

    'Now change the properties back to their original values
    revolve.RevolutionAngle = revolve.RevolutionAngle / (3.14 / 2)
    revolve.UIsolineDensity = revolve.UIsolineDensity / 2#
    revolve.VIsolineDensity = revolve.VIsolineDensity / 0.5
End Sub

Private Sub LoftedSurfaceProperties(lofted As AcadLoftedSurface)
    AppActivate ThisDrawing.Application.Caption
    
    GetSurfaceBoundingBox lofted
    MsgBox "SurfaceType: " & lofted.SurfaceType & vbCr & _
           "NumCrossSections: " & lofted.NumCrossSections & vbCr & _
           "NumGuidePaths: " & lofted.NumGuidePaths & vbCr & _
           "SurfaceNormals: " & lofted.SurfaceNormals & vbCr & _
           "StartDraftAngle: " & lofted.StartDraftAngle & vbCr & _
           "StartDraftMagnitude: " & lofted.StartDraftMagnitude & vbCr & _
           "EndDraftAngle: " & lofted.EndDraftAngle & vbCr & _
           "EndDraftMagnitude: " & lofted.EndDraftMagnitude & vbCr & _
           "Closed: " & lofted.Closed & vbCr & _
           "Material: " & lofted.Material & vbCr & _
           "UIsolineDensity: " & lofted.UIsolineDensity & vbCr & _
           "VIsolineDensity: " & lofted.VIsolineDensity

    'Now change the configurable properties
    lofted.StartDraftAngle = lofted.StartDraftAngle * (3.14 / 2)
    lofted.EndDraftAngle = lofted.EndDraftAngle * (3.14 / 4)
    lofted.UIsolineDensity = lofted.UIsolineDensity * 2#
    lofted.VIsolineDensity = lofted.VIsolineDensity * 0.5

    ThisDrawing.Regen acActiveViewport
    Utility.GetString 0, "Press return to continue..."

    'Now change the properties back to their original values
    lofted.StartDraftAngle = lofted.StartDraftAngle / (3.14 / 2)
    lofted.EndDraftAngle = lofted.EndDraftAngle / (3.14 / 4)
    lofted.UIsolineDensity = lofted.UIsolineDensity / 2#
    lofted.VIsolineDensity = lofted.VIsolineDensity / 0.5
End Sub

Private Sub SweptSurfaceProperties(swept As AcadSweptSurface)
    AppActivate ThisDrawing.Application.Caption
    
    GetSurfaceBoundingBox swept
    MsgBox "SurfaceType: " & swept.SurfaceType & vbCr & _
           "ProfileRotation: " & swept.ProfileRotation & vbCr & _
           "Bank: " & swept.Bank & vbCr & _
           "Twist: " & swept.Twist & vbCr & _
           "scale: " & swept.scale & vbCr & _
           "Length: " & swept.length & vbCr & _
           "Material: " & swept.Material & vbCr & _
           "UIsolineDensity: " & swept.UIsolineDensity & vbCr & _
           "VIsolineDensity: " & swept.VIsolineDensity

    swept.ProfileRotation = swept.ProfileRotation * 3.14 * 0.25
    swept.Bank = Not swept.Bank
    swept.Twist = swept.Twist * 3.14 * -0.5
    swept.UIsolineDensity = swept.UIsolineDensity * 2#
    swept.VIsolineDensity = swept.VIsolineDensity * 0.5

    ThisDrawing.Regen acActiveViewport
    Utility.GetString 0, "Press return to continue..."

    'Now change the properties back to their original values
    swept.ProfileRotation = swept.ProfileRotation / (3.14 * 0.25)
    swept.Bank = Not swept.Bank
    swept.Twist = swept.Twist / (3.14 * -0.5)
    swept.UIsolineDensity = swept.UIsolineDensity / 2#
    swept.VIsolineDensity = swept.VIsolineDensity / 0.5
End Sub

Private Sub PlaneSurfaceProperties(planar As AcadPlaneSurface)
    AppActivate ThisDrawing.Application.Caption
    
    GetSurfaceBoundingBox planar
    MsgBox "SurfaceType: " & planar.SurfaceType & vbCr & _
           "UIsolineDensity: " & planar.UIsolineDensity & vbCr & _
           "VIsolineDensity: " & planar.VIsolineDensity

    planar.UIsolineDensity = planar.UIsolineDensity * 2#
    planar.VIsolineDensity = planar.VIsolineDensity * 0.5

    ThisDrawing.Regen acActiveViewport
    Utility.GetString 0, "Press return to continue..."

    'Now change the properties back to their original values
    planar.UIsolineDensity = planar.UIsolineDensity / 2#
    planar.VIsolineDensity = planar.VIsolineDensity / 0.5
End Sub

Private Sub GetSurfaceBoundingBox(surf As AcadSurface)
    Dim MinPoint As Variant
    Dim MaxPoint As Variant

    surf.GetBoundingBox MinPoint, MaxPoint

    ' Print the min and max extents
    MsgBox "The extents of the bounding box for the surface are:" & vbCrLf _
           & "Min Point: " & MinPoint(0) & "," & MinPoint(1) & "," & MinPoint(2) _
           & vbCrLf & "Max Point: " & MaxPoint(0) & "," & MaxPoint(1) & "," & MaxPoint(2), vbInformation, "GetBoundingBox of Surface"
End Sub

Visual LISP:

(vl-load-com)
(defun c:SurfaceProperties()
    (setq acadObj (vlax-get-acad-object))
    (setq doc (vla-get-ActiveDocument acadObj))

    (setq ssetObj (vla-Add (vla-get-SelectionSets doc) "SURFACES2"))

    (vla-SelectOnScreen ssetObj)

    (vlax-for obj ssetObj
        (setq objName (vla-get-ObjectName obj))

        (cond
          ((= "AcDb3dSolid" objName)
            (cond
                ((= (vla-get-SolidType obj) "Extrusion") (alert "Extruded solid selected."))
                ((= (vla-get-SolidType obj) "Revolve") (alert "Revolved solid selected."))
                ((= (substr (vla-get-SolidType obj) 1 4) "Loft") (alert "Lofted solid selected."))
                ((= (vla-get-SolidType obj) "Sweep") (alert "Swept solid selected."))
            )
          )
          ((= "AcDbExtrudedSurface" objName) (ExtrudedSurfaceProperties obj))
          ((= "AcDbRevolvedSurface" objName) (RevolvedSurfaceProperties obj))
          ((= "AcDbLoftedSurface" objName) (LoftedSurfaceProperties obj))
          ((= "AcDbSweptSurface" objName) (SweptSurfaceProperties obj))
          ((= "AcDbPlaneSurface" objName) (PlaneSurfaceProperties obj))
        )      
    )

    (vla-Delete ssetObj)
)

(defun ExtrudedSurfaceProperties (extrude / )
    (GetSurfaceBoundingBox extrude)

    (alert (strcat "SurfaceType: " (vla-get-SurfaceType extrude)
                   "\nHeight: " (rtos (vla-get-Height extrude) 2)
                   "\nTaperAngle: " (rtos (vla-get-TaperAngle extrude) 2)
                   "\nMaterial: " (vla-get-Material extrude)
                   "\nUIsolineDensity: " (itoa (vla-get-UIsolineDensity extrude))
                   "\nVIsolineDensity: " (itoa (vla-get-VIsolineDensity extrude))))
    ;; Now change the configurable properties
    (vla-put-Height extrude (* (vla-get-Height extrude) 1.5))
    (vla-put-TaperAngle extrude (* (vla-get-TaperAngle extrude) (/ 3.14 2)))
    (vla-put-UIsolineDensity extrude (* (vla-get-UIsolineDensity extrude) 2))
    (vla-put-VIsolineDensity extrude (* (vla-get-VIsolineDensity extrude) 0.5))

    (vla-Regen doc acActiveViewport)
    (vla-GetString (vla-get-Utility doc) 0 "Press return to continue...")
  
    ;; Now change the properties back to their original values
    (vla-put-Height extrude (/ (vla-get-Height extrude) 1.5))
    (vla-put-TaperAngle extrude (/ (vla-get-TaperAngle extrude) (/ 3.14 2)))
    (vla-put-UIsolineDensity extrude (/ (vla-get-UIsolineDensity extrude) 2))
    (vla-put-VIsolineDensity extrude (/ (vla-get-VIsolineDensity extrude) 0.5))
)

(defun RevolvedSurfaceProperties (revolve / )
    (GetSurfaceBoundingBox revolve)

    (alert (strcat "SurfaceType: " (vla-get-SurfaceType revolve)
                   "\nRevolutionAngle: " (rtos (vla-get-RevolutionAngle revolve) 2)
                   "\nMaterial: " (vla-get-Material revolve)
                   "\nUIsolineDensity: " (itoa (vla-get-UIsolineDensity revolve))
                   "\nVIsolineDensity: " (itoa (vla-get-VIsolineDensity revolve))))
  
    ;; Now change the configurable properties
    (vla-put-RevolutionAngle revolve (* (vla-get-RevolutionAngle revolve) (/ 3.14 2)))
    (vla-put-UIsolineDensity revolve (* (vla-get-UIsolineDensity revolve) 2))
    (vla-put-VIsolineDensity revolve (* (vla-get-VIsolineDensity revolve) 0.5))

    (vla-Regen doc acActiveViewport)
    (vla-GetString (vla-get-Utility doc) 0 "Press return to continue...")

    ;; Now change the properties back to their original values
    (vla-put-RevolutionAngle revolve (/ (vla-get-RevolutionAngle revolve) (/ 3.14 2)))
    (vla-put-UIsolineDensity revolve (/ (vla-get-UIsolineDensity revolve) 2))
    (vla-put-VIsolineDensity revolve (/ (vla-get-VIsolineDensity revolve) 0.5))
)


(defun LoftedSurfaceProperties (lofted / )
    (GetSurfaceBoundingBox lofted) 

    (alert (strcat "SurfaceType: " (vla-get-SurfaceType lofted)
                   "\nNumCrossSections: " (itoa (vla-get-NumCrossSections lofted))
                   "\nNumGuidePaths: " (itoa (vla-get-NumGuidePaths lofted))
                   "\nSurfaceNormals: " (itoa (vla-get-SurfaceNormals lofted))
                   "\nStartDraftAngle: " (rtos (vla-get-StartDraftAngle lofted) 2)
                   "\nStartDraftMagnitude: " (rtos (vla-get-StartDraftMagnitude lofted) 2)
                   "\nEndDraftAngle: " (rtos (vla-get-EndDraftAngle lofted) 2)
                   "\nEndDraftMagnitude: " (rtos (vla-get-EndDraftMagnitude lofted) 2)
                   "\nClosed: " (if (= (vla-get-Closed lofted) :vlax-true) "True" "False")
                   "\nMaterial: " (vla-get-Material lofted)
                   "\nUIsolineDensity: " (itoa (vla-get-UIsolineDensity lofted))
                   "\nVIsolineDensity: " (itoa (vla-get-VIsolineDensity lofted))))

    ;; Now change the configurable properties
    (vla-put-StartDraftAngle lofted (* (vla-get-StartDraftAngle lofted) (/ 3.14 2)))
    (vla-put-EndDraftAngle lofted (* (vla-get-EndDraftAngle lofted) (/ 3.14 4)))
    (vla-put-UIsolineDensity lofted (* (vla-get-UIsolineDensity lofted) 2))
    (vla-put-VIsolineDensity lofted (* (vla-get-VIsolineDensity lofted) 0.5))

    (vla-Regen doc acActiveViewport)
    (vla-GetString (vla-get-Utility doc) 0 "Press return to continue...")

    ;; Now change the properties back to their original values
    (vla-put-StartDraftAngle lofted (/ (vla-get-StartDraftAngle lofted) (/ 3.14 2)))
    (vla-put-EndDraftAngle lofted (/ (vla-get-EndDraftAngle lofted) (/ 3.14 4)))
    (vla-put-UIsolineDensity lofted (/ (vla-get-UIsolineDensity lofted) 2))
    (vla-put-VIsolineDensity lofted (/ (vla-get-VIsolineDensity lofted) 0.5))
)

(defun SweptSurfaceProperties (swept / )
    (GetSurfaceBoundingBox swept)  
  
    (alert (strcat "SurfaceType: " (vla-get-SurfaceType swept)
                   "\nProfileRotation: " (rtos (vla-get-ProfileRotation swept) 2)
                   "\nBank: " (if (= (vla-get-Bank swept) :vlax-true) "True" "False")
                   "\nTwist: " (rtos (vla-get-Twist swept) 2)
                   "\nscale: " (rtos (vla-get-Scale swept) 2)
                   "\nLength: " (rtos (vla-get-Length swept) 2)
                   "\nMaterial: " (vla-get-Material swept)
                   "\nUIsolineDensity: " (itoa (vla-get-UIsolineDensity swept))
                   "\nVIsolineDensity: " (itoa (vla-get-VIsolineDensity swept))))

    (vla-put-ProfileRotation swept (* (vla-get-ProfileRotation swept) (* 3.14 0.25)))
    (vla-put-Bank swept (if (= (vla-get-Bank swept) :vlax-true) :vlax-false :vlax-true))
    (vla-put-Twist swept (* (vla-get-Twist swept) (* 3.14 -0.5)))
    (vla-put-UIsolineDensity swept (* (vla-get-UIsolineDensity swept) 2))
    (vla-put-VIsolineDensity swept (* (vla-get-VIsolineDensity swept) 0.5))

    (vla-Regen doc acActiveViewport)
    (vla-GetString (vla-get-Utility doc) 0 "Press return to continue...")

    ;; Now change the properties back to their original values
    (vla-put-ProfileRotation swept (/ (vla-get-ProfileRotation swept) (* 3.14 0.25)))
    (vla-put-Bank swept (if (= (vla-get-Bank swept) :vlax-true) :vlax-false :vlax-true))
    (vla-put-Twist swept (/ (vla-get-Twist swept) (* 3.14 -0.5)))
    (vla-put-UIsolineDensity swept (/ (vla-get-UIsolineDensity swept) 2))
    (vla-put-VIsolineDensity swept (/ (vla-get-VIsolineDensity swept) 0.5))
)

(defun PlaneSurfaceProperties (planar / )
    (GetSurfaceBoundingBox planar)  

    (alert (strcat "SurfaceType: " (vla-get-SurfaceType planar)
                   "\nUIsolineDensity: " (itoa (vla-get-UIsolineDensity planar))
                   "\nVIsolineDensity: " (itoa (vla-get-VIsolineDensity planar))))

    (vla-put-UIsolineDensity planar (* (vla-get-UIsolineDensity planar) 2))
    (vla-put-VIsolineDensity planar (* (vla-get-VIsolineDensity planar) 0.5))

    (vla-Regen doc acActiveViewport)
    (vla-GetString (vla-get-Utility doc) 0 "Press return to continue...")

    ;; Now change the properties back to their original values
    (vla-put-UIsolineDensity planar (/ (vla-get-UIsolineDensity planar) 2))
    (vla-put-VIsolineDensity planar (/ (vla-get-VIsolineDensity planar) 0.5))
)

(defun GetSurfaceBoundingBox (surf / )
    (vla-GetBoundingBox surf 'MinPoint 'MaxPoint)

    ;; Print the min and max extents
    (alert (strcat "The extents of the bounding box for the surface are:"
                   "\nMin Point: " (rtos (vlax-safearray-get-element MinPoint 0) 2) ","
                                   (rtos (vlax-safearray-get-element MinPoint 1) 2) ","
                                   (rtos (vlax-safearray-get-element MinPoint 2) 2)
                   "\nMax Point: " (rtos (vlax-safearray-get-element MaxPoint 0) 2) ","
                                   (rtos (vlax-safearray-get-element MaxPoint 1) 2) ","
                                   (rtos (vlax-safearray-get-element MaxPoint 2) 2)))
)

路过

雷人

握手

鲜花

鸡蛋

最新评论

QQ|Archiver|CAD开发者社区 ( 苏ICP备2022047690号-1 )

GMT+8, 2024-5-12 01:02

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

返回顶部