Lets just say I am lost!!!!!!!!! VBA to Visual Lisp
Lets just say I am lost!!!!!!!!! VBA to Visual Lisp
(OP)
Below is some code I am attempting to translate to visual lisp. We have upgraded to 2010 and would like to get away from the VBA editor and I can see it will eventually just go away. What it does is takes some blocks on two specific layers and changes the arcs and/or splines and changes the lintype to continous. The blocks are all related to project numbers and have 100's of different names. I think I may be on the right track with the selection set but dont know what I need to do next.I have commented out the VBA code.
CODE
(defun c:fixhist () ;;; Sub ChBlockEntProp()
(vl-load-com);;;Dim objSSet As AcadSelectionSet
(vla-get-acad-object)
(SETQ SS1 (SSGET "x" '((0 . "insert")(-4 . "<or")(8 . "a-hist")(8 . "a-hist-2000")(-4 . "or>"))));;;filtertype(0) = 0
;;;filterdata(0) = "INSERT"
;;;filtertype(1) = -4
;;;filterdata(1) = "<or"
;;;filtertype(2) = 8
;;;filterdata(2) = "a-hist"
;;;filtertype(3) = 8
;;;filterdata(3) = "a-hist-2000"
;;;filtertype(4) = -4
;;;filterdata(4) = "or>"
;;;Set objSSet = ThisDrawing.SelectionSets.Add("BlkSet")
;;;objSSet.Select acSelectionSetAll, , , filtertype, filterdata
;;;Dim objBlock As AcadBlock
;;;Dim objBlkRef As AcadBlockReference
;;;Dim objCadEnt As AcadEntity
;;;For Each objBlkRef In objSSet
;;; For Each objBlock In ThisDrawing.Blocks
;;; If StrComp(objBlkRef.Name, objBlock.Name) = 0 Then
;;; For Each objCadEnt In objBlock
;;; With objCadEnt
;;; If .ObjectName = "AcDbArc" Or .ObjectName = "AcDbSpline" Then
;;; .Linetype = "continuous"
;;; End If
;;; End With
;;; Next
;;; End If
;;; Next
;;;Next
;;;Set objCadEnt = Nothing
;;;Set objBlkRef = Nothing
;;;Set objBlock = Nothing
;;;objSSet.Delete
;;;ThisDrawing.Regen acActiveViewport
;;;ThisDrawing.SendCommand "_vbaunload" & vbCr & "fixhist.dvb" & vbCr
;;;End Sub
(vl-load-com);;;Dim objSSet As AcadSelectionSet
(vla-get-acad-object)
(SETQ SS1 (SSGET "x" '((0 . "insert")(-4 . "<or")(8 . "a-hist")(8 . "a-hist-2000")(-4 . "or>"))));;;filtertype(0) = 0
;;;filterdata(0) = "INSERT"
;;;filtertype(1) = -4
;;;filterdata(1) = "<or"
;;;filtertype(2) = 8
;;;filterdata(2) = "a-hist"
;;;filtertype(3) = 8
;;;filterdata(3) = "a-hist-2000"
;;;filtertype(4) = -4
;;;filterdata(4) = "or>"
;;;Set objSSet = ThisDrawing.SelectionSets.Add("BlkSet")
;;;objSSet.Select acSelectionSetAll, , , filtertype, filterdata
;;;Dim objBlock As AcadBlock
;;;Dim objBlkRef As AcadBlockReference
;;;Dim objCadEnt As AcadEntity
;;;For Each objBlkRef In objSSet
;;; For Each objBlock In ThisDrawing.Blocks
;;; If StrComp(objBlkRef.Name, objBlock.Name) = 0 Then
;;; For Each objCadEnt In objBlock
;;; With objCadEnt
;;; If .ObjectName = "AcDbArc" Or .ObjectName = "AcDbSpline" Then
;;; .Linetype = "continuous"
;;; End If
;;; End With
;;; Next
;;; End If
;;; Next
;;;Next
;;;Set objCadEnt = Nothing
;;;Set objBlkRef = Nothing
;;;Set objBlock = Nothing
;;;objSSet.Delete
;;;ThisDrawing.Regen acActiveViewport
;;;ThisDrawing.SendCommand "_vbaunload" & vbCr & "fixhist.dvb" & vbCr
;;;End Sub
Talk To Other Members
RE: Lets just say I am lost!!!!!!!!! VBA to Visual Lisp
RE: Lets just say I am lost!!!!!!!!! VBA to Visual Lisp
CODE
(vl-load-com) ; load the visual lisp extensions
(setq acadDocument (vla-get-activedocument (vlax-get-acad-object)))
;retrieve a reference to the documents object
(setq ssets (vla-get-selectionsets acadDocument))
;retrieve a reference to the selection sets object
(setq newsset (vla-add ssets "SS1")) ;add a new selection set
(setq filter_code (vlax-make-safearray vlax-vbinteger '(0 . 4)))
;create a 5 element array for the DXF Code
(setq filter_value (vlax-make-safearray vlax-vbvariant '(0 . 4)))
;;;;create a 5 element array for the values
(vlax-safearray-fill filter_code '(0 -4 8 8 -4))
;;;;DXF Code for Objects and Layer
(vlax-safearray-fill
filter_value
'("insert" "<OR" "A-Hist" "A-HIST-2000" "OR>")
)
;;;;the filter values
(vla-select
newsset acSelectionSetAll nil nil filter_code filter_value)
;;;;select ALL Blocks on Layers A-hist or a-hist-2000
(setq ctr 0) ;set the counter to zero
(repeat (vla-get-count newsset) ;count the number of objects and loop
(setq item (vla-item newsset ctr)) ;retrieve each object
(setq check (vlax-property-available-p item "LAYER" T))
;check if the entity has a layer property and can it be updated
(if check ;if it can
(vlax-put-property item 'LAYER "A-WALL-SLAB") ;change it's layer
) ; end if
(setq ctr (1+ ctr)) ;increment the counter
) ;repeat
(vla-delete (vla-item ssets "SS1")) ;delete the selection set
(princ)
) ;defun
(princ)
;if