subtlation发表于2004-3-19 8:38:00static/image/common/back.gif请教一下明总：
For i = 0 To ss.Count - 1 语句
next
是不是每次运行循环回到for语句时，ss,count就会重新计算一次？
还有就是CS.Erase语句把圆...
<BR>1.For ...Next是循环语句，循环过程中ss.Count不重新计算，而只计算第一次，然后按每循环一次<EM>i值</EM>递增1。
2.CS.Erase删除对象后，选择集中的对象数量会变小，但对于循环的次数不会改变。
3.假定是实体ss(2)被删除，那么以后引用ss(2)时，会出错，所以程序设置了出错判断来跳过。
要取得同心圆块，应当把所有圆心点归到同一个点集中ss ，取出其中一个点P1，再把这个点与点集中ss的点比较，若有n个相等值(n>0)，则把n个相等值点P2对应的圆O2归入一起B1块中，同时把P2移出点集ss ,再此循环以上操作，直到点集ss 为 nil为止。
取同心圆其实很简单，也用带过滤器的选择集，过滤出同心的圆，有没有看到我在VBA中的写法，就是用这种方法。
usercoolbo发表于2004-3-17 10:46:00static/image/common/back.gif能不能用LISP编写啊,VBA我有点看不懂,谢了
<FONT style="BACKGROUND-COLOR: #f3f3f3">;;將圓批量轉為塊的程式<BR>;;By 龍龍仔(LUCAS)<BR>(defun C:CBB (/ HOLDOSMODE HOLDECHO SS LST N A B X)<BR> (setq HOLDECHO (getvar "cmdecho"))<BR> (setvar "cmdecho" 0)<BR> (setq HOLDOSMODE (getvar "osmode"))<BR> (setvar "osmode" 0)<BR> (setq SS (ssget "x"<BR> (list '(0 . "CIRCLE") (cons 410 (getvar "ctab")))<BR> )<BR> N 0<BR> )<BR> (repeat (sslength SS)<BR> (if (not<BR> (member (setq CEN (cdr (assoc 10 (entget (ssname SS N)))))<BR> LST<BR> )<BR> )<BR> (setq LST (cons CEN LST))<BR> )<BR> (setq N (1+ N))<BR> )<BR> (setq A (* (getvar "CDATE") 1E8))<BR> (mapcar '(lambda (X)<BR> (while (progn (setq B (rtos (setq A (1+ A))))<BR> (tblsearch "block" B)<BR> )<BR> )<BR> (command<BR> "_.block"<BR> B<BR> X<BR> (ssget "X" (list '(0 . "CIRCLE") '(-4 . "=") (cons 10 X)))<BR> ""<BR> )<BR> (command "_.insert" B X "" "" "")<BR> ;(print B) ;注意:B可不是連續的!<BR> )<BR> LST<BR> )<BR> (command "_.erase" SS "")<BR> (setvar "osmode" HOLDOSMODE)<BR> (setvar "cmdecho" HOLDECHO)<BR> (princ)<BR>)</FONT><BR>
关注中
谢谢龙龙仔了,小弟前些时候出差了,过会我试试!
考考大家。
难道没有写的更简单的么？或者其它的写法。
<FONT style="BACKGROUND-COLOR: #f3f3f3">如果不是对全图 (ssget "X" (list '(0 . "CIRCLE") '(-4 . "=") (cons 10 X))) 怎么变通？</FONT>
<FONT style="BACKGROUND-COLOR: #f3f3f3"><BR>
</FONT>
<FONT style="BACKGROUND-COLOR: #f3f3f3">如果不是对全图????你想说甚么?</FONT>
这样么？Public Sub test()
On Error Resume Next Dim ft(0) As Integer, fd(0)
Dim ss As AcadSelectionSet
Dim Cols As New Collection
Dim Objs As AcadBlock
Dim pnt
Dim strName As String
Dim entitys(0) As AcadEntity
ThisDrawing.SelectionSets("*TlsTest*").Delete
Set ss = ThisDrawing.SelectionSets.Add("*TlsTest*")
ft(0) = 0: fd(0) = "Circle"
ss.Select acSelectionSetAll, , , ft, fd
For Each i In ss
pnt = i.Center
strName = pnt(0) & "," & pnt(1) & "," & pnt(2)
Err.Clear
Set Objs = ThisDrawing.Blocks(Cols(strName))
If Err Then
Set Objs = ThisDrawing.Blocks.Add(pnt, "*U")
Cols.Add Objs.Name, strName
End If
Set entitys(0) = i
ThisDrawing.CopyObjects entitys, Objs
Next i
For Each i In Cols
ThisDrawing.ModelSpace.InsertBlock ThisDrawing.Blocks(i).origin, i, 1, 1, 1, 0
Next i
ss.Erase
End Sub
sorry! 何为启动组？