關于CAD導入SU前斷線的問題

馬上注冊，結交更多好友，享用更多功能，讓你輕松玩轉社區。

您需要登錄才可以下載或查看，沒有帳號？立即加入SketchUp吧！

x

1、首先，用那個BREAKALL的LISP在AUTOCAD2010加載后，運行QINGLI顯示未知命令！郁悶啊！！
先共享一下

breakall lisp.rar (295.51 KB, 下載次數: 303) ，雖然我用不了。
有AUTOCAD2010能用的么？還是我哪里設置的不對？

2、然后，今天在網上找了個VB宏腳本，也共享給大家。

Sub 交點處等間距打斷()
  On Error Resume Next
  Dim ssetObj As AcadSelectionSet
  '創建選擇集
  Set ssetObj = ThisDrawing.SelectionSets("test")
  If Err Then
   Err.Clear
   Set ssetObj = ThisDrawing.SelectionSets.Add("test")
  End If
  ssetObj.Clear '首先清空選擇集
  ssetObj.Select acSelectionSetAll

  Dim jianju As Double
  jianju = ThisDrawing.Utility.GetReal("指定打斷間距：")
  If Err Then Exit Sub

'  取得交點
  Dim i As Long
  Dim j As Long
  Dim k As Long
  Dim pt As Variant
  Dim points() As Double
  Dim N As Long
  N = 0
  For i = 0 To ssetObj.Count - 2
For j = i + 1 To ssetObj.Count - 1
   pt = ssetObj(i).IntersectWith(ssetObj(j), acExtendNone)
   If UBound(pt) >= 2 Then
      ReDim Preserve points(N + UBound(pt)) '逐步定義數組，需要關鍵字
      For k = 0 To UBound(pt)
      points(N + k) = pt(k)
      Next
      N = N + UBound(pt) + 1
   End If
Next
  Next

  '交點處打斷
  Dim bpt(0 To 2) As Double
  Dim circleObj As AcadCircle
  Dim cpt As Variant
  Dim cpt1(2) As Double
  Dim cpt2(2) As Double
  Dim ss As AcadSelectionSet
  Set ss = ThisDrawing.SelectionSets("dog")
  If Err Then
   Err.Clear
   Set ss = ThisDrawing.SelectionSets.Add("dog")
  End If
  For i = 0 To UBound(points) Step 3
bpt(0) = points(i)
bpt(1) = points(i + 1)
bpt(2) = points(i + 2)
ss.Clear
SelectAtPoint ss, bpt
Set circleObj = ThisDrawing.ModelSpace.AddCircle(bpt, jianju / 2)
For k = 0 To ss.Count - 1
   cpt = ss(k).IntersectWith(circleObj, acExtendNone)
   If UBound(cpt) = 5 Then
      cpt1(0) = cpt(0)
      cpt1(1) = cpt(1)
      cpt1(2) = cpt(2)
      cpt2(0) = cpt(3)
      cpt2(1) = cpt(4)
      cpt2(2) = cpt(5)
      ThisDrawing.SendCommand "_break" & vbCr & axEnt2lspEnt(ss(k)) & vbCr & axPoint2lspPoint(cpt1) & vbCr & axPoint2lspPoint(cpt2) & vbCr
   End If
Next
circleObj.Delete
  Next
End Sub

' 選擇通過某點的實體
Public Sub SelectAtPoint(ByRef SSet As AcadSelectionSet, ByVal pt As Variant)
' 構造一個以pt為中心的小矩形作為選擇范圍
Dim pt1 As Variant, pt2 As Variant
Dim objUtility As Object
Set objUtility = ThisDrawing.Utility ' 必須使用后期綁定
objUtility.CreateTypedArray pt1, vbDouble, pt(0) - 0.0001, pt(1) - 0.0001, pt(2)
objUtility.CreateTypedArray pt2, vbDouble, pt(0) + 0.0001, pt(1) + 0.0001, pt(2)

SSet.Select acSelectionSetCrossing, pt1, pt2
End Sub
' 轉換點的函數
Public Function axPoint2lspPoint(ByVal pnt As Variant) As String
axPoint2lspPoint = pnt(0) & "," & pnt(1) & "," & pnt(2)
End Function
' 轉換圖元函數
Public Function axEnt2lspEnt(ByVal entObj As AcadEntity) As String
Dim entHandle As String
entHandle = entObj.Handle
axEnt2lspEnt = "(handent " & Chr(34) & entHandle & Chr(34) & ")"
End Function

但是這個有幾個問題，圓不能打斷，打斷間距不能為0，又是個比較郁悶的。
有達人會修改成在原點打斷么？

本貼附件下載

breakall lisp.rar

295.51 KB , 吧幣: 200 , 請登陸后再進行下載！