關(guān)于CAD導(dǎo)入SU前斷線的問題

馬上注冊(cè)，結(jié)交更多好友，享用更多功能，讓你輕松玩轉(zhuǎn)社區(qū)。

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

x

1、首先，用那個(gè)BREAKALL的LISP在AUTOCAD2010加載后，運(yùn)行QINGLI顯示未知命令！郁悶?。?！
先共享一下

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

2、然后，今天在網(wǎng)上找了個(gè)VB宏腳本，也共享給大家。

Sub 交點(diǎn)處等間距打斷()
  On Error Resume Next
  Dim ssetObj As AcadSelectionSet
  '創(chuàng)建選擇集
  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

'  取得交點(diǎn)
  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)) '逐步定義數(shù)組，需要關(guān)鍵字
      For k = 0 To UBound(pt)
      points(N + k) = pt(k)
      Next
      N = N + UBound(pt) + 1
   End If
Next
  Next

  '交點(diǎn)處打斷
  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

' 選擇通過某點(diǎn)的實(shí)體
Public Sub SelectAtPoint(ByRef SSet As AcadSelectionSet, ByVal pt As Variant)
' 構(gòu)造一個(gè)以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
' 轉(zhuǎn)換點(diǎn)的函數(shù)
Public Function axPoint2lspPoint(ByVal pnt As Variant) As String
axPoint2lspPoint = pnt(0) & "," & pnt(1) & "," & pnt(2)
End Function
' 轉(zhuǎn)換圖元函數(shù)
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

但是這個(gè)有幾個(gè)問題，圓不能打斷，打斷間距不能為0，又是個(gè)比較郁悶的。
有達(dá)人會(huì)修改成在原點(diǎn)打斷么？

本貼附件下載

breakall lisp.rar

295.51 KB , 吧幣: 200 , 請(qǐng)登陸后再進(jìn)行下載！