2013.05.26 08:03
안녕하세요.
객체를 선택해서 컬러를 변경하는 기능인데요,
Lock 걸린 레이어 객체가 선택되면 런타임 오류가 발생합니다.
Lock 레이어를 제외하고 선택하고 싶은데
어찌 수정해야 할지 조언부탁드립니다.
Sub ChangeColor()
UserForm1.hide
Dim objSelected As Object
Dim objSelSet As AcadSelectionSet
On Error Resume Next
If ThisDrawing.SelectionSets.Item("SS1") Then
ThisDrawing.SelectionSets.Item("SS1").Delete
End If
Set objSelSet = ThisDrawing.SelectionSets.add("SS1")
On Error GoTo 0
Dim DG_Code(10) As Integer
Dim DG_Data(10) As Variant
DG_Code(0) = -4: DG_Data(0) = "<and"
DG_Code(1) = -4: DG_Data(1) = "<or"
DG_Code(2) = 0: DG_Data(2) = "Line"
DG_Code(3) = 0: DG_Data(3) = "Arc"
DG_Code(4) = 0: DG_Data(4) = "Circle"
DG_Code(5) = 0: DG_Data(5) = "Lwpolyline"
DG_Code(6) = -4: DG_Data(6) = "or>"
DG_Code(7) = -4: DG_Data(7) = "<not"
DG_Code(8) = 8: DG_Data(8) = "TEMP"
DG_Code(9) = -4: DG_Data(9) = "not>"
DG_Code(10) = -4: DG_Data(10) = "and>"
objSelSet.SelectOnScreen DG_Code, DG_Data
Dim objEnt As Object
For Each objEnt In objSelSet
If Not (objEnt.color = 2) Then '//노랑색이 아니면 1번컬러로 변경
objEnt.color = 1
End If
Next
Unload UserForm1
End Sub
2013.05.26 12:11
2013.05.26 14:13
'// 중략
Dim objEnt As Object
Dim ctr As Control '//--------?????
Dim objLayer As AcadLayer '//-------?????
Dim colLayers As AcadLayers '//--------?????
Set colLayers = ThisDrawing.Layers '//-------?????
For Each objEnt In objSelSet
If Not (objEnt.color = 2) Then
Set ctr = objLayer.Controls(objEnt.Layer) '//---------?????
If ctr.Lock = False Then '//-----------------------------?????
objEnt.color = 1
End If
End If
Next
????? --------- 이부분을 추가했는데요.
원하는 대로 실행이 안됩니다.
저는 왜 응용이 안되는 걸까요?? ㅎㅎ
2013.05.26 21:20
2013.05.27 01:00
이런식으로 하면 됩니다.
Dim oEnt As AcadEntity
Dim oLayer As AcadLayer
For Each oEnt In oSel
With oEnt
Set oLayer = ThisDrawing.Layers(.Layer)
If oLayer.Lock = False Then
.Color = 1
End If
End With
Next
Set oLayer = Nothing
그리고..
이와 같이 코드가 간단하고
에러가 락 걸린 레이어 외에는 없는 경우처럼
에러 날 여지가 없다고 판단되면 그냥 최초 코드 그냥 사용하시고
코드 맨 처음에 On Error Resume Next 이거 하나 넣으시고
에러가 나도 그냥 무시하고 넘어가도록해도 됩니다.
On Error Resume Next가 절대 좋은 것은 아니나
한눈에 봐도 코드가 간단하고 에러날 부분이 뻔하면
에러 날 것에 대비해 코드 길게 만드느니
그냥 무시하고 넘어가도 되는쪽이 나을 수도 있습니다.
2013.05.28 11:47
번호 | 제목 | 글쓴이 | 날짜 | 조회 수 |
---|---|---|---|---|
공지 | ★ 드림플러스 질문은 메일 또는 홈페이지에 부탁합니다 ★ | 아저씨 | 2017.05.16 | 2756 |
공지 | 제목이 엉망이면 답변달지 않습니다. [1] | 아저씨 | 2014.04.04 | 23846 |
공지 | 순수 캐드 질문은 고캐드로 | 아저씨 | 2013.05.28 | 68628 |
공지 | 질문 답변 게시판을 만들었습니다. | 아저씨 | 2013.02.09 | 74940 |
1861 | 캐드오류 질문?? [1] | 건설인 | 2013.05.27 | 2738 |
1860 | 진심으로 존경하는 개발자님~! 64비트에 관하여서; [3] | 1111 | 2013.03.11 | 2737 |
1859 | 다중플롯 문제.. [1] | 플롯이 | 2013.05.27 | 2729 |
1858 | CAD-숨은객체 보이는 방법 [1] | 박선희 | 2013.07.30 | 2727 |
1857 | 드림설치가 않되요 [1] | 바람 | 2013.04.24 | 2707 |
» | Lock 걸린 레이어 제외하고 객체선택 방법질문입니다. [5] | 올빼미 | 2013.05.26 | 2705 |
1855 | CAD 계산기가 안열립니다. [2] | 안녕하세요 | 2013.06.20 | 2704 |
1854 | 드림에서 옵션변경오류 [1] | 꽃버린남자 | 2013.04.22 | 2700 |
1853 | 드림 치수관련 [2] | 김연수 | 2013.03.28 | 2698 |
1852 | 다른이름으로 저장... [3] | 씨빌3D | 2013.03.12 | 2690 |
1851 | 64bit에 캐드 설치시 문제점 문의드립니다. [1] | 세아들 | 2013.07.24 | 2689 |
1850 | ZWCAD용으로 부탁드립니다. [1] | JWL | 2013.06.21 | 2689 |
1849 | 도면축척 질문 답변좀 꼭부탁드리겟습니다.. [3] | 캐드허당 | 2013.07.18 | 2667 |
1848 | DREAM 설치 문제 [2] | 김해정 | 2013.04.09 | 2661 |
1847 | 캐드를 킬때마다 드림 아이콘툴이 다 튀어나와요~ [3] | 쩔어욘 | 2013.03.07 | 2644 |
락 걸린 레이어의 객체 속성을 변경할 때 에러가 발생되므로
순환할 때
objEnt 의 레이어 락이 False 인 경우만 색을 변경하도록 if 한번 더 넣으면 될겁니다.