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 |
166 | [질문] 곡선상에서 임의의 점에서 특정 거리에 있는 지점을 표시하는 방법 [1] | 김진찬 | 2017.10.20 | 13 |
165 | 텍스트 활성시 계산기의 어느 버튼을 클릭했을 때 나오는법 [1] | 요리사 | 2017.04.07 | 13 |
164 | 드림플러스 메뉴얼 문의드립니다. [7] | park | 2016.12.26 | 13 |
163 | 도면분할시 창 오른쪽부분이 짤려서 도면추가를 할수없습니다. [1] | 빨리빨리 | 2016.07.27 | 13 |
162 | Move ..질문있습니다. [1] | 바츠 | 2016.09.28 | 12 |
161 | 질문있습니다. [1] | blue | 2016.06.27 | 12 |
160 | 누적으로 offset되는기능 [1] | 은선 | 2015.10.21 | 12 |
159 | 도면추가 질문입니다 [3] | 초보입니다 | 2015.09.30 | 12 |
158 | 메일 확인 부탁드립니다. [1] | 샘 | 2017.10.16 | 11 |
157 | lin 적용 유지에 대한 질문 드립니다 [2] | 최성준 | 2023.08.18 | 11 |
156 | 질문있습니다 [1] | 토당 | 2016.04.06 | 11 |
155 | 윈도우 다시 설치후 드림 메뉴판에 글씨가 깨집니다. [1] | hwsehy | 2017.04.03 | 10 |
154 | fte관련 질문드립니다. [1] | 111 | 2016.10.31 | 10 |
153 | 드림실행후 Excel 2013 사용이 잘안됩니다. [6] | Excel 2013 | 2013.02.17 | 10 |
152 | 드림 도구모음 없는명령중 hsd vsd 축척고정 문의 [1] | kecc | 2018.05.07 | 9 |
락 걸린 레이어의 객체 속성을 변경할 때 에러가 발생되므로
순환할 때
objEnt 의 레이어 락이 False 인 경우만 색을 변경하도록 if 한번 더 넣으면 될겁니다.