在AutoCAD里可以通过 List 和Area命令求的样条曲线等任意一条曲线的长度。但是要在delphi得到AutoCAD里任意一条曲线的长度就需要编写宏,然后再将宏嵌入到Delphi里
这是在AutoCAD2004下调试通过的宏
Sub SecFunc()
Dim SelectionSet As AcadSelectionSet
Dim lSpLine As AcadSpline
Dim sysVarName As String
Dim sysVarData As Variant
Dim DataType As Integer
ThisDrawing.SelectionSets.Item(0).Delete
Set SelectionSet = ThisDrawing.SelectionSets.Add("New_SelectionSet")
SelectionSet.SelectOnScreen
Dim SelectionSet As AcadSelectionSet
Dim lSpLine As AcadSpline
Dim sysVarName As String
Dim sysVarData As Variant
Dim DataType As Integer
ThisDrawing.SelectionSets.Item(0).Delete
Set SelectionSet = ThisDrawing.SelectionSets.Add("New_SelectionSet")
SelectionSet.SelectOnScreen
Set lSpLine = SelectionSet.Item(0)
ThisDrawing.SetVariable "USERR1", 1.5
ThisDrawing.SendCommand "(vl-load-com)" & vbCr
Dim StrCom As String
StrCom = "(setvar " & Chr(34) & "USERR1" & Chr(34) & Chr(32) & "(vlax-curve-getdistatparam (vlax-ename->vla-object (handent " & Chr(34) & lSpLine.Handle & Chr(34) & ")) (vlax-curve-getendparam (vlax-ename->vla-object (handent " & Chr(34) & lSpLine.Handle & Chr(34) & ")))))" & vbCr
ThisDrawing.SendCommand StrCom
MsgBox StrCom
sysVarData = ThisDrawing.GetVariable("USERR1")
MsgBox sysVarData
End Sub
ThisDrawing.SetVariable "USERR1", 1.5
ThisDrawing.SendCommand "(vl-load-com)" & vbCr
Dim StrCom As String
StrCom = "(setvar " & Chr(34) & "USERR1" & Chr(34) & Chr(32) & "(vlax-curve-getdistatparam (vlax-ename->vla-object (handent " & Chr(34) & lSpLine.Handle & Chr(34) & ")) (vlax-curve-getendparam (vlax-ename->vla-object (handent " & Chr(34) & lSpLine.Handle & Chr(34) & ")))))" & vbCr
ThisDrawing.SendCommand StrCom
MsgBox StrCom
sysVarData = ThisDrawing.GetVariable("USERR1")
MsgBox sysVarData
End Sub
这是Delphi里对该宏的嵌入式调用
function GetLengthOfObject(pHandle:THandle;pCadDoc:OleVariant):Real;
var
lTempVariant:OleVariant;
lTempVar:wideString;
begin
lTempVariant:=0;
lTempVar:='USERR1';
pCadDoc.SetVariable(lTempVar,lTempVariant);
lTempVar:='(vl-load-com)' + #13;
pCadDoc.SendCommand(lTempVar);
var
lTempVariant:OleVariant;
lTempVar:wideString;
begin
lTempVariant:=0;
lTempVar:='USERR1';
pCadDoc.SetVariable(lTempVar,lTempVariant);
lTempVar:='(vl-load-com)' + #13;
pCadDoc.SendCommand(lTempVar);
lTempVar:='(setvar ' + Chr(34) + 'USERR1'+Chr(34)+ Chr(32) +
'(vlax-curve-getdistatparam (vlax-ename->vla-object '+
'(handent '+ Chr(34) +IntToStr(pHandle)+ Chr(34)+')) '+
'(vlax-curve-getendparam (vlax-ename->vla-object '+
'(handent '+ Chr(34) +IntToStr(pHandle)+Chr(34) +
')))))'+#13;
pCadDoc.SendCommand(lTempVar);
Result:=pCadDoc.GetVariable('USERR1');
end;
体会:
'(vlax-curve-getdistatparam (vlax-ename->vla-object '+
'(handent '+ Chr(34) +IntToStr(pHandle)+ Chr(34)+')) '+
'(vlax-curve-getendparam (vlax-ename->vla-object '+
'(handent '+ Chr(34) +IntToStr(pHandle)+Chr(34) +
')))))'+#13;
pCadDoc.SendCommand(lTempVar);
Result:=pCadDoc.GetVariable('USERR1');
end;
体会:
1,宏的语法就是VB的语法。
2,宏里面的"&"符号就是字符串的连接,在delphi里面就是字符串的相加。比如
宏里面的 "(setvar " & Chr(34) & "USERR1" & Chr(34) & Chr(32)
在delphi里面就是"(setvar " + Chr(34) + "USERR1" + Chr(34) + Chr(32)
其中 Chr(34)是 " 符号 Chr(32)是空字符
3 宏里面的VbCr就相当于是按了一下回车键,而在delphi里面就是#13
4 在delphi里面嵌套宏一定要注意空格和回车。比如在宏里面是"USERR1",在delphi里 面也必须写成:'USERR1',如果写成'USERR1 ',在连接AutoCAD时就会出线“呼叫被拒绝”,或者是及时在delphi里面能运行通过,你却得不到想要的结果。
5 关于参数的传递 与函数的调用。
AutoCAD里提供一个设置系统变量的函数 SetVariable 原型是:
object.SetVariable Name, Value
Object :
Document
The object or objects this method applies to.
The object or objects this method applies to.
Name :String; input-only
The name of the system variable to set.
The name of the system variable to set.
Value:Variant; input-only
The new value for the specified system variable.
The new value for the specified system variable.
Example
Sub Example_SetVariable() ' This example sets various system variables, each of ' a different data type. Dim sysVarName As String Dim sysVarData As Variant Dim DataType As Integer ' Set FILEDIA system variable (data type Integer) to 1. NOTE that ' you need to declare a variable as the data type of system variable, ' assign data to that variable and then make it variant type Dim intData As Integer sysVarName = "FILEDIA" intData = 1 sysVarData = intData ' Integer data ThisDrawing.SetVariable sysVarName, sysVarData ' Check the variable using GetVariable sysVarData = ThisDrawing.GetVariable(sysVarName) MsgBox sysVarName & " = " & sysVarData, , "SetVariable Example" ' Set DCTCUST system variable (data type String) to "My Custom Dictionary" Dim strData As String sysVarName = "DCTCUST" strData = "My Custom Dictionary" sysVarData = strData ' String data ThisDrawing.SetVariable sysVarName, sysVarData ' Check the variable using GetVariable sysVarData = ThisDrawing.GetVariable(sysVarName) MsgBox sysVarName & " = " & sysVarData, , "SetVariable Example" ' Set CHAMFERA system variable (data type Double) to 1.5 Dim dataDouble As Double sysVarName = "CHAMFERA" dataDouble = 1.5 sysVarData = dataDouble ' Double data ThisDrawing.SetVariable sysVarName, sysVarData ' Check the variable using GetVariable sysVarData = ThisDrawing.GetVariable(sysVarName) MsgBox sysVarName & " = " & sysVarData, , "SetVariable Example" ' Set INSBASE system variable (data type array) to (1.0,1.0,0) Dim arrayData3D(0 To 2) As Double sysVarName = "INSBASE" arrayData3D(0) = 1#: arrayData3D(1) = 1#: arrayData3D(2) = 0 sysVarData = arrayData3D ' 3D array data ThisDrawing.SetVariable sysVarName, sysVarData ' Check the variable using GetVariable sysVarData = ThisDrawing.GetVariable(sysVarName) MsgBox sysVarName & " = " & sysVarData(0) & ", " & sysVarData(1) & ", " & sysVarData(2), , "SetVariable Example" End Sub
这个函数在AutoCAD提供的类型库里的原型是这样的:
procedure SetVariable(const Name: WideString; Value: OleVariant); safecall;
理论上这样调用是没有问题的
SetVariable('USERR1',1.5);
但是这样编译能通的过去,运行的时候就会报错“无法设置系统变量值”
如果声明一个WideString类型的变量就可以了 如:
var
lName:WideString;
lName:='USERR1';
SetVariable(lName,1.5);
转载于:https://blog.51cto.com/bigpower/92208