[LISP程序]：需要既看的懂VB又能写LISP的朋友帮忙

linhui12

VERSION 5.00
Begin VB.Form Form1
   Caption         =   "弯管程序计算"
   ClientHeight    =   7035
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9990
   MaxButton       =   0   'False
   ScaleHeight     =   7035
   ScaleWidth      =   9990
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox semidia
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   2160
      TabIndex        =   16
      ToolTipText     =   "该管所使用的弯模的半径，全部使用定型弯头时填写定型弯头半径（本程序不适用于既有机弯又有定型弯头的情况）"
      Top             =   4320
      Width           =   2000
   End
   Begin VB.TextBox 总长
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   2160
      TabIndex        =   20
      Top             =   6360
      Width           =   2000
   End
   Begin VB.CommandButton 清空
      BackColor       =   &H00C0C0C0&
      Caption         =   "全部清空"
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   8160
      TabIndex        =   18
      ToolTipText     =   "清除所有方框内的值"
      Top             =   4200
      Width           =   1575
   End
   Begin VB.CommandButton 计算弯管程序
      BackColor       =   &H00C0C0C0&
      Caption         =   "计算弯管程序"
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   4952
      TabIndex        =   17
      ToolTipText     =   "根据所给的各管段坐标差值计算该管的弯管程序——作者:郭有茂
      Top             =   4200
      Width           =   2415
   End
   Begin VB.TextBox Z5
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   6120
      TabIndex        =   15
      Top             =   3480
      Width           =   1455
   End
   Begin VB.TextBox Y5
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   3960
      TabIndex        =   14
      Top             =   3480
      Width           =   1455
   End
   Begin VB.TextBox X5
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1800
      TabIndex        =   13
      Top             =   3480
      Width           =   1455
   End
   Begin VB.TextBox L5
      BackColor       =   &H00FFC0C0&
      Enabled         =   0   'False
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   8280
      TabIndex        =   35
      Top             =   3480
      Width           =   1455
   End
   Begin VB.TextBox L4
      BackColor       =   &H00FFC0C0&
      Enabled         =   0   'False
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   8280
      TabIndex        =   30
      Top             =   2820
      Width           =   1455
   End
   Begin VB.TextBox L3
      BackColor       =   &H00FFC0C0&
      Enabled         =   0   'False
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   8280
      TabIndex        =   29
      Top             =   2160
      Width           =   1455
   End
   Begin VB.TextBox L2
      BackColor       =   &H00FFC0C0&
      Enabled         =   0   'False
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   8280
      TabIndex        =   28
      Top             =   1500
      Width           =   1455
   End
   Begin VB.TextBox L1
      BackColor       =   &H00FFC0C0&
      Enabled         =   0   'False
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   8280
      TabIndex        =   27
      Top             =   840
      Width           =   1455
   End
   Begin VB.TextBox X4
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1800
      TabIndex        =   10
      Top             =   2820
      Width           =   1455
   End
   Begin VB.TextBox Y4
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   3960
      TabIndex        =   11
      Top             =   2820
      Width           =   1455
   End
   Begin VB.TextBox Z4
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   6120
      TabIndex        =   12
      Top             =   2820
      Width           =   1455
   End
   Begin VB.TextBox Z3
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   6120
      TabIndex        =   9
      Top             =   2160
      Width           =   1455
   End
   Begin VB.TextBox Z2
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   6120
      TabIndex        =   6
      Top             =   1500
      Width           =   1455
   End
   Begin VB.TextBox Z1
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   6120
      TabIndex        =   3
      ToolTipText     =   "管子第二点与第一点的高度方向距离（从里向外为正）"
      Top             =   840
      Width           =   1455
   End
   Begin VB.TextBox Y3
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   3960
      TabIndex        =   8
      Top             =   2160
      Width           =   1455
   End
   Begin VB.TextBox Y2
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   3960
      TabIndex        =   5
      Top             =   1500
      Width           =   1455
   End
   Begin VB.TextBox Y1
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   3960
      TabIndex        =   2
      ToolTipText     =   "管子第二点与第一点的纵向距离（向上为正）"
      Top             =   840
      Width           =   1455
   End
   Begin VB.TextBox X3
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1800
      TabIndex        =   7
      Top             =   2160
      Width           =   1455
   End
   Begin VB.TextBox X2
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1800
      TabIndex        =   4
      Top             =   1500
      Width           =   1455
   End
   Begin VB.TextBox X1
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1800
      TabIndex        =   1
      ToolTipText     =   "管子第二点与第一点的横向距离（向右为正）"
      Top             =   840
      Width           =   1455
   End
   Begin VB.TextBox 弯管程序
      BeginProperty Font
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   240
      MultiLine       =   -1  'True
      TabIndex        =   19
      Top             =   5640
      Width           =   9375
   End
   Begin VB.Label Label11
      Caption         =   "第六点"
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   240
      TabIndex        =   36
      Top             =   3480
      Width           =   1095
   End
   Begin VB.Label Label4
      Caption         =   "第二点"
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   240
      TabIndex        =   34
      Top             =   840
      Width           =   1095
   End
   Begin VB.Label Label5
      Caption         =   "第三点"
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   240
      TabIndex        =   33
      Top             =   1500
      Width           =   1095
   End
   Begin VB.Label Label6
      Caption         =   "第四点"
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   240
      TabIndex        =   32
      Top             =   2160
      Width           =   1095
   End
   Begin VB.Label Label8
      Caption         =   "第五点"
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   240
      TabIndex        =   31
      Top             =   2820
      Width           =   1095
   End
   Begin VB.Label Label10
      Caption         =   "管段长度L"
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   8160
      TabIndex        =   26
      ToolTipText     =   "管子相邻两点间的距离"
      Top             =   240
      Width           =   1575
   End
   Begin VB.Label Label9
      Caption         =   "该管总长="
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   240
      TabIndex        =   25
      Top             =   6480
      Width           =   1575
   End
   Begin VB.Label Label7
      Caption         =   "该管弯管程序如下："
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   240
      TabIndex        =   24
      Top             =   5040
      Width           =   3015
   End
   Begin VB.Label 弯曲半径
      Caption         =   "弯曲半径R="
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   240
      TabIndex        =   23
      Top             =   4320
      Width           =   1695
   End
   Begin VB.Label Label3
      Caption         =   "Z方向差"
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   6045
      TabIndex        =   22
      Top             =   240
      Width           =   1575
   End
   Begin VB.Label Label2
      Caption         =   "Y方向差"
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   3915
      TabIndex        =   21
      Top             =   240
      Width           =   1575
   End
   Begin VB.Label Label1
      Caption         =   "X方向差"
      BeginProperty Font
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1800
      TabIndex        =   0
      Top             =   240
      Width           =   1575
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const pi As Double = 3.14159265358979

Private Sub 计算弯管程序_Click()

Dim nPX1 As Long, nPY1 As Long, nPZ1 As Long
Dim nPX2 As Long, nPY2 As Long, nPZ2 As Long
Dim nPX3 As Long, nPY3 As Long, nPZ3 As Long
Dim nPX4 As Long, nPY4 As Long, nPZ4 As Long
Dim nPX5 As Long, nPY5 As Long, nPZ5 As Long
Dim WANGLE1 As Double
Dim WANGLE2 As Double
Dim WANGLE3 As Double
Dim WANGLE4 As Double
Dim RANGLE1 As Double
Dim RANGLE2 As Double
Dim RANGLE3 As Double
Dim RealLen1 As Long
Dim RealLen2 As Long
Dim RealLen3 As Long
Dim RealLen4 As Long
Dim RealLen5 As Long
Dim WQBJ As Long

WQBJ = Val(Me.semidia)
nPX1 = Val(Me.X1)
nPY1 = Val(Me.Y1)
nPZ1 = Val(Me.Z1)
nPX2 = Val(Me.X2)
nPY2 = Val(Me.Y2)
nPZ2 = Val(Me.Z2)
nPX3 = Val(Me.X3)
nPY3 = Val(Me.Y3)
nPZ3 = Val(Me.Z3)
nPX4 = Val(Me.X4)
nPY4 = Val(Me.Y4)
nPZ4 = Val(Me.Z4)
nPX5 = Val(Me.X5)
nPY5 = Val(Me.Y5)
nPZ5 = Val(Me.Z5)

If (Abs(nPX1) + Abs(nPY1) + Abs(nPZ1) = 0 Or Abs(nPX2) + Abs(nPY2) + Abs(nPZ2) = 0) Then
    Exit Sub
End If

If (Abs(nPX5) + Abs(nPY5) + Abs(nPZ5)) <> 0 Then
    WANGLE1 = WANGLE(nPX1, nPY1, nPZ1, nPX2, nPY2, nPZ2)
    WANGLE2 = WANGLE(nPX2, nPY2, nPZ2, nPX3, nPY3, nPZ3)
    WANGLE3 = WANGLE(nPX3, nPY3, nPZ3, nPX4, nPY4, nPZ4)
    WANGLE4 = WANGLE(nPX4, nPY4, nPZ4, nPX5, nPY5, nPZ5)
    RANGLE1 = ROANGLE(nPX1, nPY1, nPZ1, nPX2, nPY2, nPZ2, nPX3, nPY3, nPZ3)
    RANGLE2 = ROANGLE(nPX2, nPY2, nPZ2, nPX3, nPY3, nPZ3, nPX4, nPY4, nPZ4)
    RANGLE3 = ROANGLE(nPX3, nPY3, nPZ3, nPX4, nPY4, nPZ4, nPX5, nPY5, nPZ5)
   
    RealLen1 = PPLEN(nPX1, nPY1, nPZ1) - QXLEN(WQBJ, WANGLE1)
    RealLen2 = PPLEN(nPX2, nPY2, nPZ2) - QXLEN(WQBJ, WANGLE1) - QXLEN(WQBJ, WANGLE2)
    RealLen3 = PPLEN(nPX3, nPY3, nPZ3) - QXLEN(WQBJ, WANGLE2) - QXLEN(WQBJ, WANGLE3)
    RealLen4 = PPLEN(nPX4, nPY4, nPZ4) - QXLEN(WQBJ, WANGLE3) - QXLEN(WQBJ, WANGLE4)
    RealLen5 = PPLEN(nPX5, nPY5, nPZ5) - QXLEN(WQBJ, WANGLE4)
   
    Me.弯管程序.Text = "长 " & RealLen1 & " 弯 " & HuduToDu(WANGLE1) & "°长 " & RealLen2 & " 转 " & HuduToDu(RANGLE1) & "°弯 " & HuduToDu(WANGLE2) & "°长 " & RealLen3 & " 转 " & HuduToDu(RANGLE2) & "°弯 " & HuduToDu(WANGLE3) & "°长 " & RealLen4 & " 转 " & HuduToDu(RANGLE3) & "°弯 " & HuduToDu(WANGLE4) & "°长 " & RealLen5
    Me.总长.Text = PPLEN(nPX1, nPY1, nPZ1) + PPLEN(nPX2, nPY2, nPZ2) + PPLEN(nPX3, nPY3, nPZ3) + PPLEN(nPX4, nPY4, nPZ4) + PPLEN(nPX5, nPY5, nPZ5)
    Me.L1.Text = PPLEN(nPX1, nPY1, nPZ1)
    Me.L2.Text = PPLEN(nPX2, nPY2, nPZ2)
    Me.L3.Text = PPLEN(nPX3, nPY3, nPZ3)
    Me.L4.Text = PPLEN(nPX4, nPY4, nPZ4)
    Me.L5.Text = PPLEN(nPX5, nPY5, nPZ5)

ElseIf (Abs(nPX4) + Abs(nPY4) + Abs(nPZ4)) <> 0 Then
    WANGLE1 = WANGLE(nPX1, nPY1, nPZ1, nPX2, nPY2, nPZ2)
    WANGLE2 = WANGLE(nPX2, nPY2, nPZ2, nPX3, nPY3, nPZ3)
    WANGLE3 = WANGLE(nPX3, nPY3, nPZ3, nPX4, nPY4, nPZ4)
    RANGLE1 = ROANGLE(nPX1, nPY1, nPZ1, nPX2, nPY2, nPZ2, nPX3, nPY3, nPZ3)
    RANGLE2 = ROANGLE(nPX2, nPY2, nPZ2, nPX3, nPY3, nPZ3, nPX4, nPY4, nPZ4)

    RealLen1 = PPLEN(nPX1, nPY1, nPZ1) - QXLEN(WQBJ, WANGLE1)
    RealLen2 = PPLEN(nPX2, nPY2, nPZ2) - QXLEN(WQBJ, WANGLE1) - QXLEN(WQBJ, WANGLE2)
    RealLen3 = PPLEN(nPX3, nPY3, nPZ3) - QXLEN(WQBJ, WANGLE2) - QXLEN(WQBJ, WANGLE3)
    RealLen4 = PPLEN(nPX4, nPY4, nPZ4) - QXLEN(WQBJ, WANGLE3)
   
    Me.弯管程序.Text = "长 " & RealLen1 & " 弯 " & HuduToDu(WANGLE1) & "°长 " & RealLen2 & " 转 " & HuduToDu(RANGLE1) & "°弯 " & HuduToDu(WANGLE2) & "°长 " & RealLen3 & " 转 " & HuduToDu(RANGLE2) & "°弯 " & HuduToDu(WANGLE3) & "°长 " & RealLen4
    Me.总长.Text = PPLEN(nPX1, nPY1, nPZ1) + PPLEN(nPX2, nPY2, nPZ2) + PPLEN(nPX3, nPY3, nPZ3) + PPLEN(nPX4, nPY4, nPZ4)
    Me.L1.Text = PPLEN(nPX1, nPY1, nPZ1)
    Me.L2.Text = PPLEN(nPX2, nPY2, nPZ2)
    Me.L3.Text = PPLEN(nPX3, nPY3, nPZ3)
    Me.L4.Text = PPLEN(nPX4, nPY4, nPZ4)
ElseIf (Abs(nPX3) + Abs(nPY3) + Abs(nPZ3)) <> 0 Then
    WANGLE1 = WANGLE(nPX1, nPY1, nPZ1, nPX2, nPY2, nPZ2)
    WANGLE2 = WANGLE(nPX2, nPY2, nPZ2, nPX3, nPY3, nPZ3)
    RANGLE1 = ROANGLE(nPX1, nPY1, nPZ1, nPX2, nPY2, nPZ2, nPX3, nPY3, nPZ3)

    RealLen1 = PPLEN(nPX1, nPY1, nPZ1) - QXLEN(WQBJ, WANGLE1)
    RealLen2 = PPLEN(nPX2, nPY2, nPZ2) - QXLEN(WQBJ, WANGLE1) - QXLEN(WQBJ, WANGLE2)
    RealLen3 = PPLEN(nPX3, nPY3, nPZ3) - QXLEN(WQBJ, WANGLE2)
    Me.弯管程序.Text = "长 " & RealLen1 & " 弯 " & HuduToDu(WANGLE1) & "°长 " & RealLen2 & " 转 " & HuduToDu(RANGLE1) & "°弯 " & HuduToDu(WANGLE2) & "°长 " & RealLen3
    Me.总长.Text = PPLEN(nPX1, nPY1, nPZ1) + PPLEN(nPX2, nPY2, nPZ2) + PPLEN(nPX3, nPY3, nPZ3)
    Me.L1.Text = PPLEN(nPX1, nPY1, nPZ1)
    Me.L2.Text = PPLEN(nPX2, nPY2, nPZ2)
    Me.L3.Text = PPLEN(nPX3, nPY3, nPZ3)
Else
    WANGLE1 = WANGLE(nPX1, nPY1, nPZ1, nPX2, nPY2, nPZ2)
    RealLen1 = PPLEN(nPX1, nPY1, nPZ1) - QXLEN(WQBJ, WANGLE1)
    RealLen2 = PPLEN(nPX2, nPY2, nPZ2) - QXLEN(WQBJ, WANGLE1)
    Me.弯管程序.Text = "长 " & RealLen1 & " 弯 " & HuduToDu(WANGLE1) & "°长 " & RealLen2
    Me.总长.Text = PPLEN(nPX1, nPY1, nPZ1) + PPLEN(nPX2, nPY2, nPZ2)
    Me.L1.Text = PPLEN(nPX1, nPY1, nPZ1)
    Me.L2.Text = PPLEN(nPX2, nPY2, nPZ2)
End If

End Sub
Function PPLEN(nX As Long, nY As Long, nZ As Long) As Double
PPLEN = Sqr(nX * nX + nY * nY + nZ * nZ)
End Function
Function WANGLE(nX1 As Long, nY1 As Long, nZ1 As Long, nX2 As Long, nY2 As Long, nZ2 As Long) As Double
Dim ARCTEMP As Double
Dim ARCTEMP1 As Double
ARCTEMP = (nX1 * nX2 + nY1 * nY2 + nZ1 * nZ2) / (PPLEN(nX1, nY1, nZ1) * PPLEN(nX2, nY2, nZ2))
ARCTEMP1 = Fix(ARCTEMP * 10) / 10
If (ARCTEMP1 = 1) Then
WANGLE = 0
Exit Function
Else
If (ARCTEMP1 = -1) Then
WANGLE = pi
Exit Function
Else
WANGLE = Atn(-ARCTEMP / Sqr(1 - ARCTEMP * ARCTEMP)) + 2 * Atn(1)
End If
End If
End Function
Function ROANGLE(nX1 As Long, nY1 As Long, nZ1 As Long, nX2 As Long, nY2 As Long, nZ2 As Long, nX3 As Long, nY3 As Long, nZ3 As Long) As Double
Dim ARCTEMP As Double
Dim ARCTEMP1 As Double
Dim WANGLE1 As Double
Dim WANGLE2 As Double
Dim SLEN1 As Double
Dim SLEN3 As Double
Dim STEMPF As Double
Dim STEMPF1 As Double
Dim STEMPF2 As Double
Dim STEMPN As Double
Dim STEMPL As Double
Dim STEMP2 As Double
Dim RODIRT As Long


SLEN1 = PPLEN(nX1, nY1, nZ1)
SLEN3 = PPLEN(nX3, nY3, nZ3)
WANGLE1 = WANGLE(nX1, nY1, nZ1, nX2, nY2, nZ2)
WANGLE2 = WANGLE(nX2, nY2, nZ2, nX3, nY3, nZ3)
If (WANGLE1 = 0 Or WANGLE2 = 0) Then
ROANGLE = 0
Exit Function
Else
If (WANGLE1 = (pi / 2)) Then
STEMPF1 = 0
Else
STEMPF1 = 1 / Tan(WANGLE1)
End If
If (WANGLE2 = (pi / 2)) Then
STEMPF2 = 0
Else
STEMPF2 = 1 / Tan(WANGLE2)
End If
STEMPF = STEMPF1 * STEMPF2
STEMPN = nX1 * nX3 + nY1 * nY3 + nZ1 * nZ3
STEMPL = Sin(WANGLE1) * Sin(WANGLE2) * SLEN1 * SLEN3
ARCTEMP = STEMPF - STEMPN / STEMPL
ARCTEMP1 = Fix(ARCTEMP * 10) / 10
If (ARCTEMP1 = 1) Then
ROANGLE = 0
Exit Function
Else
If (ARCTEMP1 = -1) Then
ROANGLE = pi
Exit Function
Else
RODIRT = nX1 * nY2 * nZ3 - nX1 * nY3 * nZ2 + nX2 * nY3 * nZ1 - nX2 * nY1 * nZ3 + nX3 * nY1 * nZ2 - nX3 * nY2 * nZ1

STEMP2 = Sqr(1 - ARCTEMP * ARCTEMP)
If (RODIRT <= 0) Then
ROANGLE = Atn(-ARCTEMP / STEMP2) + 2 * Atn(1)
Else
ROANGLE = -(Atn(-ARCTEMP / STEMP2) + 2 * Atn(1))
End If
End If
End If
End If
End Function
Function HuduToDu(SHudu As Double) As Long
HuduToDu = SHudu / pi * 180

End Function
Function QXLEN(semidia As Long, ANGLE1 As Double) As Double
If (ANGLE1 = pi) Then
QXLEN = 2 * semidia
Else
QXLEN = semidia * Tan(ANGLE1 / 2)
End If
End Function

Private Sub 清空_Click()

    Me.X1.Text = ""
    Me.X2.Text = ""
    Me.X3.Text = ""
    Me.X4.Text = ""
    Me.X5.Text = ""
    Me.Y1.Text = ""
    Me.Y2.Text = ""
    Me.Y3.Text = ""
    Me.Y4.Text = ""
    Me.Y5.Text = ""
    Me.Z1.Text = ""
    Me.Z2.Text = ""
    Me.Z3.Text = ""
    Me.Z4.Text = ""
    Me.Z5.Text = ""
    Me.L1.Text = ""
    Me.L2.Text = ""
    Me.L3.Text = ""
    Me.L4.Text = ""
    Me.L5.Text = ""
    Me.semidia.Text = ""
    Me.弯管程序.Text = ""
    Me.总长.Text = ""
   
End Sub


哪位朋友能根据以上这段VB程序原码的原理，帮忙用LISP写个程序，使得我在CAD中启动命令->选择一根POLYLINE线（<=6个顶点），就能得出以上原码中的“弯管程序”值啊。麻烦各位了.附上以上VB源程序编译出来的EXE文件给大家参考

aeo

其实你贴个图，说明一下已知条件和目标就好理解的多。
lisp会比vb简单的多

linhui12

谢谢班主回复,我的要求是在CAD中任选一根(3或4点)POLYLINE,后用户输入弯曲半径R即可得到"弯管程序",希望得到您的帮助