Insert the process in which the graphics file in the entire directory is selected into the graphics
Sub intblkbydirdwg ()
ON Error Goto Err_Control
Dim Blkfile As Variant
DIM I as integer
DIM InstPNT As Variant
DIM BLKREFOBJ As AcadblockReference
DIM VARCANCEL As Variant
BLKFILE = GETDIR ("Select the directory where you want to insert the graphic:" * .dwg ")
If isarray (blkfile) THISDRAWING.UTILITY.PROMPT VBCRLF & "You selected" & stricks & stricks & stricks & stricks & stricks - 1) & "Graphics" for i = 0 to Ubound (blkfile) instpnt = thisdrawing.utility.getPoint (, VBCRLF & "Please select Graphics" & JustFileName (BLKFILE (i)) & "Insert Point:") Set BLKREfobj = thisDrawing.Modelspace.InsertBlock (instpnt, _ blkfile (i), 1 #, 1 #, 1 # , 0 #) Next
END IF
EXIT_HERE: EXIT SUB ERR_Control: Select Case Err.Number Case -2147352567 VARCANCEL = thisDrawing.getvariable ("Lastprompt") IF INSTR (1, Varcancel, "* Cancel *") <> 0 and INSTR (1, Varcancel, "* Cancel * ") <> 0 Then Err.clear resume EXIT_HERE ELSE Err.Clear Resume end if case -2145320928 err.clear resume EXIT_HERE CASE ELSE RESUME EXIT_HERE END SELECT
End Sub
'Return to the specified directory Function GetFileListBypath (path as string, filename as string) AS VARIANT
DIM S AS STRING DIM SFILES () AS STRING DIM I AS INTEGER S = DIR (Path & FileName) If S <> "" THEN Redim Sfiles (i) AS String Sfiles (i) = PATH & S i = 1 s = DIR () While S <> "" Redim Preserve Sfiles (i) AS String Sfiles (I) = PATH & S i = i 1 S = DIR () Wend getFileListBypath = sfiles endfilelistbypath = sfiles end if End function 'Selected Directory function, use Commondialog class public function Getdir (Dialogtitle As String, FileName As String) AS VARIANT
DIM DLG AS CommonDialog Dim Path As String Dim Filelist As Variant
Set DLG = New Commondialog Dlg.dialogtitle = Dialogtitle if Dlg.Browse Then Path = DLG.Path IF Path <> "" "" "" "" "" "" "" "" "" "" "" "" "" <> "/" = Path & "filelist = getfilelistbypath (path," * .dwg ") getdir = filelist end if enddiff
END FUNCTION
'Returning file full path name Public Function JustFileName (filename) AS STRING ON ERROR RESUME NEXT DIM Count As integer for count = len (filename) - 1 to 1 step -1 if mid (filename, count, 1) = "/" OR MID (Filename, Count, 1) = "/" THEN JUSTFILENAME = Right (filename, len (filename) - count EXIT for end if next end function
